!====================================================!
! I/O routines !
!====================================================!
! SUBROUTINE openfile(funit,ifile,iform,istatus, & !
! iaccess,iaction,iposition) !
! SUBROUTINE closefile(funit) !
! SUBROUTINE read_input !
! SUBROUTINE read_data !
! SUBROUTINE read__sdf_data !
! SUBROUTINE write_field(filename) !
! SUBROUTINE write_sdf_field(filename) !
! SUBROUTINE shutdown(message,error) !
!====================================================!
MODULE io
  IMPLICIT NONE

  CONTAINS

  !--------------------------------------------------------!
  ! SUBROUTINE openfile !
  !--------------------------------------------------------!
  ! PURPOSE: !
  ! Determines a file unit number, then opens ifile with !
  ! the approriate arguments !
  !--------------------------------------------------------!
  SUBROUTINE openfile(funit,ifile,iform,istatus,iaccess,iaction,iposition)
    USE params
    IMPLICIT NONE

    ! Dummy variable declarations
    CHARACTER(LEN=*), INTENT(IN) :: ifile
    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: iaccess,iaction,iform, &
                                              iposition,istatus
    INTEGER(KIND=i4), INTENT(OUT) :: funit
    ! Local variables declarations
    INTEGER(KIND=i4) :: iunit=minlunit
    INTEGER(KIND=i4) :: ioerr
    LOGICAL :: lexist
    CHARACTER(LEN=20) :: iacc,iact,ifor,ipos,ista

    ! Determine unit number
    DO
      INQUIRE(iunit,OPENED=lexist)
      IF (lexist) THEN
        iunit = iunit + 1
        IF (iunit>maxlunit) THEN
          CALL shutdown('OPENFILE: No file units available')
        END IF
      ELSE
        EXIT
      END IF
    END DO
    funit = iunit

    ! Set optional arguments to default values if not passed in
    IF (PRESENT(iaccess)) THEN
      iacc = iaccess
    ELSE
      iacc = 'sequential'
    END IF
    IF (PRESENT(iaction)) THEN
      iact = iaction
    ELSE
      iact = 'readwrite'
    END IF
    IF (PRESENT(iform)) THEN
      ifor = iform
    ELSE
      ifor = 'formatted'
    END IF
    IF (PRESENT(iposition)) THEN
      ipos = iposition
    ELSE
      ipos = 'asis'
    END IF
    IF (PRESENT(istatus)) THEN
      ista = istatus
    ELSE
      ista = 'unknown'
    END IF

    OPEN(UNIT=funit,FILE=ifile,ACCESS=iacc,ACTION=iact,FORM=ifor, &
         POSITION=ipos,STATUS=ista,IOSTAT=ioerr)

    IF (ioerr/=0) THEN
      CALL shutdown('OPENFILE:',ioerr)
    END IF
  END SUBROUTINE openfile

  !--------------------------------------------------------!
  ! SUBROUTINE closefile !
  !--------------------------------------------------------!
  ! PURPOSE: !
  ! Closes a file !
  !--------------------------------------------------------!
  SUBROUTINE closefile(funit)
    USE params
    IMPLICIT NONE

    ! Dummy variable declarations
    INTEGER(KIND=i4), INTENT(IN) :: funit
    ! Local variable declarations
    INTEGER(KIND=i4) :: ioerr

    CLOSE(UNIT=funit,IOSTAT=ioerr)

    IF (ioerr/=0) THEN
      CALL shutdown('CLOSEFILE:',ioerr)
    END IF
  END SUBROUTINE closefile

  !--------------------------------------------------------!
  ! SUBROUTINE read_input !
  !--------------------------------------------------------!
  ! PURPOSE: !
  ! Reads data from file 'fff_input_pars.dat' !
  !--------------------------------------------------------!
  SUBROUTINE read_input
    USE params
    USE vars
    IMPLICIT NONE

    ! Local variable declarations
    INTEGER(KIND=i4) :: finput

    ! Read input parameters
    CALL openfile(finput,'fff_input_pars.dat',IFORM='formatted', &
                  ISTATUS='old')
    READ(UNIT=finput,FMT=*) dt
    READ(UNIT=finput,FMT=*) abs_frac_diff
    READ(UNIT=finput,FMT=*) imax
    READ(UNIT=finput,FMT=*) qsphere
    READ(UNIT=finput,FMT=*) slow
    READ(UNIT=finput,FMT=*) alpha
    CALL closefile(finput)
  END SUBROUTINE read_input

  !--------------------------------------------------------------!
  ! SUBROUTINE read_data !
  !--------------------------------------------------------------!
  ! PURPOSE: !
  ! Reads data from ASCII files 'field0.dat' and 'weight0.dat' !
  !--------------------------------------------------------------!
  SUBROUTINE read_data
    USE params
    USE vars
    IMPLICIT NONE

    ! Local variable declarations
    INTEGER(KIND=i4) :: fdata, rsize, tsize, vsize

    ! Read input magnetic field data
    CALL openfile(fdata,'field0.dat',IFORM='formatted',ISTATUS='old')
    READ(UNIT=fdata,FMT=*) nx, ny, nz
    READ(UNIT=fdata,FMT=*) bx
    READ(UNIT=fdata,FMT=*) by
    READ(UNIT=fdata,FMT=*) bz
    READ(UNIT=fdata,FMT=*) x
    READ(UNIT=fdata,FMT=*) y
    READ(UNIT=fdata,FMT=*) z
    CALL closefile(fdata)
    ! Read input weight function
    CALL openfile(fdata,'weight0.dat',IFORM='formatted',ISTATUS='old')
    READ(UNIT=fdata,FMT=*) rsize, tsize, vsize
    IF((rsize /= nx) .OR. (tsize /= ny) .OR. (vsize /= nz)) THEN
      CALL shutdown('READ_DATA: Dimension mismatch between field0.dat &
                    & and weight0.dat')
    END IF
    READ(UNIT=fdata,FMT=*) wf
    CALL closefile(fdata)
  END SUBROUTINE read_data
  !-----------------------------------------!
  ! SUBROUTINE write_field !
  !-----------------------------------------!
  ! PURPOSE: !
  ! Write out ASCII data to file filename !
  !-----------------------------------------!
  SUBROUTINE write_field(filename)
    USE params
    USE vars
    IMPLICIT NONE

    ! Dummy variable declarations
    CHARACTER(LEN=*), INTENT(IN) :: filename
    ! Local variable declarations
    INTEGER(KIND=i4) :: ffield

    ! write data to field.dat
    CALL openfile(ffield,filename,IFORM='formatted',ISTATUS='replace')
    WRITE(UNIT=ffield,FMT=10) nx, ny, nz
    WRITE(UNIT=ffield,FMT=20) bx
    WRITE(UNIT=ffield,FMT=20) by
    WRITE(UNIT=ffield,FMT=20) bz
    WRITE(UNIT=ffield,FMT=20) x
    WRITE(UNIT=ffield,FMT=20) y
    WRITE(UNIT=ffield,FMT=20) z
    CALL closefile(ffield)
 10 FORMAT(3I12)
 20 FORMAT(5F16.7)
  END SUBROUTINE write_field
  !--------------------------------------!
  ! SUBROUTINE shutdown !
  !--------------------------------------!
  ! PURPOSE: !
  ! Cleanly stop main procedure !
  ! Writes error message to log file !
  ! Closes all open file units !
  !--------------------------------------!
  SUBROUTINE shutdown(message,error)
    USE params
    USE vars, ONLY: ferror
    IMPLICIT NONE

    ! Dummy variable declarations
    CHARACTER(LEN=*), INTENT(IN) :: message
    INTEGER(KIND=i4), INTENT(IN), OPTIONAL :: error
    ! Local variable declarations
    INTEGER(KIND=i4) :: i
    LOGICAL :: lexist

    ! Write error message to log file
    IF (PRESENT(error)) THEN
      WRITE(UNIT=ferror,FMT='(1X,A,1X,"Error #",1X,I3)') message,error
    ELSE
      WRITE(UNIT=ferror,FMT='(1X,A)') message
    END IF

    ! Close open file units
    DO i=minlunit,maxlunit
      INQUIRE(i,EXIST=lexist)
      IF (lexist) THEN
        CALL closefile(i)
      END IF
    END DO

    STOP
  END SUBROUTINE shutdown

END MODULE io
