!
! NLTE_Predictor_IO
!
! Module containing routines to read and write Binary format
! NLTE_Predictor data files.
!
!
! CREATION HISTORY:
!       Written by:  Paul van Delst, 15-Mar-2011
!                    paul.vandelst@noaa.gov
!

MODULE NLTE_Predictor_IO

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use
  USE Type_Kinds           , ONLY: Long, Double
  USE File_Utility         , ONLY: File_Open, File_Exists
  USE Message_Handler      , ONLY: SUCCESS, FAILURE, WARNING, INFORMATION, Display_Message
  USE Binary_File_Utility  , ONLY: Open_Binary_File
  USE NLTE_Predictor_Define, ONLY: NLTE_Predictor_type        , &
                                   NLTE_Predictor_Destroy     , &
                                   NLTE_Predictor_ValidRelease, &
                                   NLTE_Predictor_Info
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  PUBLIC :: NLTE_Predictor_InquireFile
  PUBLIC :: NLTE_Predictor_ReadFile
  PUBLIC :: NLTE_Predictor_WriteFile
  PUBLIC :: NLTE_Predictor_IOVersion


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PRIVATE, PARAMETER :: MODULE_VERSION_ID = &
    '$Id: NLTE_Predictor_IO.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $'
  CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE'
  ! Default message length
  INTEGER, PARAMETER :: ML = 256


CONTAINS


!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTE_Predictor_InquireFile
!
! PURPOSE:
!       Function to inquire a Binary format NLTE_Predictor file.
!
! CALLING SEQUENCE:
!       Error_Status = NLTE_Predictor_InquireFile( &
!                        Filename               , &
!                        n_Profiles = n_Profiles, &
!                        Release    = Release   , &
!                        Version    = Version     )
!
! INPUTS:
!       Filename:      Character string specifying the name of the NLTE
!                      predictor data file to inquire.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUTS:
!       n_Profiles:    The number of profiles for which there is NLTE
!                      predictor information in the data file.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
!       Release:       The data/file release number. Used to check
!                      for data/software mismatch.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Version:       The data/file version number. Used for
!                      purposes only in identifying the dataset for
!                      a particular release.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:  The return value is an integer defining the error
!                      status. The error codes are defined in the
!                      Message_Handler module.
!                      If == SUCCESS the file inquire was successful
!                         == FAILURE an unrecoverable error occurred.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION NLTE_Predictor_InquireFile( &
    Filename  , &  ! Input
    n_Profiles, &  ! Optional output  
    Release   , &  ! Optional Output
    Version   ) &  ! Optional Output
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: Filename
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_Profiles
    INTEGER     , OPTIONAL, INTENT(OUT) :: Release
    INTEGER     , OPTIONAL, INTENT(OUT) :: Version
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTE_Predictor_InquireFile'
    ! Function variables
    CHARACTER(ML) :: msg
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: rel, ver, m

 
    ! Setup
    err_stat = SUCCESS
    ! ...Check that the file exists
    IF ( .NOT. File_Exists( Filename ) ) THEN
      msg = 'File '//TRIM(Filename)//' not found.'
      CALL Inquire_Cleanup(); RETURN
    END IF


    ! Open the file
    err_stat = Open_Binary_File( Filename, fid )
    IF ( err_stat /= SUCCESS ) THEN
      msg = 'Error opening '//TRIM(Filename)
      CALL Inquire_Cleanup(); RETURN
    END IF


    ! Read the release and version
    READ( fid, IOSTAT=io_stat ) rel, ver
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error reading Release/Version. IOSTAT = ",i0)' ) io_stat
      CALL Inquire_Cleanup(); RETURN
    END IF


    ! Read the number of profiles
    READ( fid, IOSTAT=io_stat ) m
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error reading dimensions from ",a,". IOSTAT = ",i0)' ) TRIM(Filename), io_stat
      CALL Inquire_Cleanup(); RETURN
    END IF


    ! Close the file
    CLOSE( fid, IOSTAT=io_stat )
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error closing ",a,". IOSTAT = ",i0)' ) TRIM(Filename), io_stat
      CALL Inquire_Cleanup(); RETURN
    END IF


    ! Assign the return arguments
    IF ( PRESENT(n_Profiles) ) n_Profiles = m
    IF ( PRESENT(Release   ) ) Release    = rel
    IF ( PRESENT(Version   ) ) Version    = ver
    
  CONTAINS
  
    SUBROUTINE Inquire_CleanUp()
      ! Close file if necessary
      IF ( File_Open(fid) ) THEN
        CLOSE( fid, IOSTAT=io_stat )
        IF ( io_stat /= 0 ) &
          msg = TRIM(msg)//'; Error closing input file during error cleanup'
      END IF
      ! Set error status and print error message
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
    END SUBROUTINE Inquire_CleanUp
    
  END FUNCTION NLTE_Predictor_InquireFile


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTE_Predictor_ReadFile
!
! PURPOSE:
!       Function to read NLTE_Predictor object files in Binary format.
!
! CALLING SEQUENCE:
!       Error_Status = NLTE_Predictor_ReadFile( &
!                        Filename      , &
!                        NLTE_Predictor, &
!                        Quiet      = Quiet     , &
!                        n_Profiles = n_Profiles  )
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       NLTE_Predictor format data file to read.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       NLTE_Predictor: NLTE_Predictor object containing the NLTE correction
!                       algorithm predictor data.
!                       UNITS:      N/A
!                       TYPE:       NLTE_Predictor_type
!                       DIMENSION:  Rank-1
!                       ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUTS:
!       Quiet:          Set this logical argument to suppress INFORMATION
!                       messages being printed to stdout
!                       If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
!                          == .TRUE.,  INFORMATION messages are SUPPRESSED.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! OPTIONAL OUTPUTS:
!       n_Profiles:     The number of profiles for which data was read.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS, the file read was successful
!                          == FAILURE, an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION NLTE_Predictor_ReadFile( &
    Filename      , &  ! Input
    NLTE_Predictor, &  ! Output
    Quiet         , &  ! Optional input
    n_Profiles    , &  ! Optional output
    Debug         ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),              INTENT(IN)  :: Filename
    TYPE(NLTE_Predictor_type), INTENT(OUT) :: NLTE_Predictor(:)
    LOGICAL,         OPTIONAL, INTENT(IN)  :: Quiet          
    INTEGER,         OPTIONAL, INTENT(OUT) :: n_Profiles
    LOGICAL,         OPTIONAL, INTENT(IN)  :: Debug          
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTE_Predictor_ReadFile'
    ! Function variables
    CHARACTER(ML) :: msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: n_file_profiles
    INTEGER :: m, n_input_profiles
    TYPE(NLTE_Predictor_type) :: dummy
    

    ! Setup
    err_stat = SUCCESS
    ! ...Check Quiet argument
    noisy = .TRUE.
    IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet
    ! ...Override Quiet settings if debug set.
    IF ( PRESENT(Debug) ) THEN
      IF ( Debug ) noisy = .TRUE.
    END IF

   
    ! Open the file if it exists
    IF ( File_Exists( Filename ) ) THEN
      err_stat = Open_Binary_File( Filename, fid )
      IF ( err_Stat /= SUCCESS ) THEN
        msg = 'Error opening '//TRIM(Filename)
        CALL Read_CleanUp(); RETURN
      END IF
    ELSE
      msg = 'File '//TRIM(Filename)//' not found.'
      CALL Read_CleanUp(); RETURN
    END IF


    ! Read and check the release and version
    READ( fid, IOSTAT=io_stat ) dummy%Release, dummy%Version
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error reading Release/Version. IOSTAT = ",i0)' ) io_stat
      CALL Read_Cleanup(); RETURN
    END IF
    IF ( .NOT. NLTE_Predictor_ValidRelease( dummy ) ) THEN
      msg = 'NLTE_Predictor Release check failed.'
      CALL Read_Cleanup(); RETURN
    END IF


    ! Read the dimensions     
    READ( fid, IOSTAT=io_stat ) n_file_profiles
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error reading profile dimension from ",a,". IOSTAT = ",i0)' ) &
             TRIM(Filename), io_stat
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Check if n_Profiles in file is > size of output array
    n_input_profiles = SIZE(NLTE_Predictor)
    IF ( n_file_profiles > n_input_profiles ) THEN
      WRITE( msg,'("Number of profiles, ",i0," > size of the output NLTE_Predictor ", &
                  &" array, ",i0,". Only the first ",i0, &
                  &" profiles will be read.")' ) &
                  n_file_profiles, n_input_profiles, n_input_profiles
      CALL Display_Message( ROUTINE_NAME, msg, WARNING )
    END IF
    n_input_profiles = MIN(n_input_profiles, n_file_profiles)
    
    
    ! Loop over all the profiles
    Profile_Loop: DO m = 1, n_input_profiles

      ! Read the NLTE predictor data
      ! ...Read the dimensions
      READ( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%n_Layers    , &
        NLTE_Predictor(m)%n_Predictors
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error reading data dimensions for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Read_Cleanup(); RETURN
      END IF
      ! ...Read the logical indicators
      READ( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%Is_Active , &
        NLTE_Predictor(m)%Compute_Tm
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error reading logical indicators for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Read_Cleanup(); RETURN
      END IF
      ! ...Read the array indices
      READ( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%k1, &
        NLTE_Predictor(m)%k2, &
        NLTE_Predictor(m)%isen, &
        NLTE_Predictor(m)%isol
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error reading array indices for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Read_Cleanup(); RETURN
      END IF
      ! ...Read the predictors and interpolation weights
      READ( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%Tm       , &
        NLTE_Predictor(m)%Predictor, &
        NLTE_Predictor(m)%w        
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error reading predictors and interpolation weights for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Read_Cleanup(); RETURN
      END IF

      ! Explicitly assign the version number
      NLTE_Predictor(m)%Version = dummy%Version

    END DO Profile_Loop
        
    
    ! Close the file
    CLOSE( fid, IOSTAT=io_stat )
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error closing ",a,". IOSTAT = ",i0)' ) TRIM(Filename), io_stat
      CALL Read_Cleanup(); RETURN
    END IF


    ! Set the return values
    IF ( PRESENT(n_Profiles) ) n_Profiles = n_input_profiles


    ! Output an info message
    IF ( Noisy ) THEN
      WRITE( msg,'("Number of profiles read from ",a,": ",i0)' ) TRIM(Filename), n_input_profiles
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
    END IF

   CONTAINS
   
     SUBROUTINE Read_CleanUp()
       IF ( File_Open(Filename) ) THEN
         CLOSE( fid, IOSTAT=io_stat )
         IF ( io_stat /= 0 ) &
           msg = TRIM(msg)//'; Error closing input file during error cleanup.'
       END IF
       CALL NLTE_Predictor_Destroy( NLTE_Predictor )
       err_stat = FAILURE
       CALL Display_Message( ROUTINE_NAME, msg, err_stat )
     END SUBROUTINE Read_CleanUp

  END FUNCTION NLTE_Predictor_ReadFile


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTE_Predictor_WriteFile
!
! PURPOSE:
!       Function to write NLTE_Predictor object files in Binary format.
!
! CALLING SEQUENCE:
!       Error_Status = NLTE_Predictor_WriteFile( &
!                        Filename           , &
!                        NLTE_Predictor     , &
!                        Quiet    = Quiet     )
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       NLTE_Predictor format data file to read.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       NLTE_Predictor: NLTE_Predictor object containing the NLTE correction
!                       algorithm predictor data.
!                       UNITS:      N/A
!                       TYPE:       NLTE_Predictor_type
!                       DIMENSION:  Rank-1
!                       ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUTS:
!       Quiet:          Set this logical argument to suppress INFORMATION
!                       messages being printed to stdout
!                       If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
!                          == .TRUE.,  INFORMATION messages are SUPPRESSED.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS, the file write was successful
!                          == FAILURE, an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION NLTE_Predictor_WriteFile( &
    Filename      , &  ! Input
    NLTE_Predictor, &  ! Input
    Quiet         , &  ! Optional input
    Debug         ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),              INTENT(IN) :: Filename
    TYPE(NLTE_Predictor_type), INTENT(IN) :: NLTE_Predictor(:)
    LOGICAL,         OPTIONAL, INTENT(IN) :: Quiet
    LOGICAL,         OPTIONAL, INTENT(IN) :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTE_Predictor_WriteFile'
    ! Function variables
    CHARACTER(ML) :: msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: m, n_output_profiles
    

    ! Setup
    err_stat = SUCCESS
    ! ...Check Quiet argument
    noisy = .TRUE.
    IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet
    ! ...Override Quiet settings if debug set.
    IF ( PRESENT(Debug) ) THEN
      IF ( Debug ) noisy = .TRUE.
    END IF

   
    ! Open the file for output
    err_stat = Open_Binary_File( Filename, fid, For_Output=.TRUE. )
    IF ( err_Stat /= SUCCESS ) THEN
      msg = 'Error opening '//TRIM(Filename)
      CALL Write_CleanUp(); RETURN
    END IF


    ! Write the release and version
    WRITE( fid,IOSTAT=io_stat ) NLTE_Predictor(1)%Release, NLTE_Predictor(1)%Version
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error writing Release/Version. IOSTAT = ",i0)' ) io_stat
      CALL Write_Cleanup(); RETURN
    END IF


    ! Write the dimensions
    n_output_profiles = SIZE(NLTE_Predictor)
    WRITE( fid, IOSTAT=io_stat ) n_output_profiles
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error writing profile dimension to ",a,". IOSTAT = ",i0)' ) &
             TRIM(Filename), io_stat
      CALL Write_Cleanup(); RETURN
    END IF
    
    
    ! Loop over all the profiles
    Profile_Loop: DO m = 1, n_output_profiles

      ! Write the NLTE predictor data
      ! ...Write the dimensions
      WRITE( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%n_Layers    , &
        NLTE_Predictor(m)%n_Predictors
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error writing data dimensions for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Write_Cleanup(); RETURN
      END IF
      ! ...Write the logical indicators
      WRITE( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%Is_Active , &
        NLTE_Predictor(m)%Compute_Tm
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error writing logical indicators for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Write_Cleanup(); RETURN
      END IF
      ! ...Write the array indices
      WRITE( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%k1, &
        NLTE_Predictor(m)%k2, &
        NLTE_Predictor(m)%isen, &
        NLTE_Predictor(m)%isol
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error writing array indices for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Write_Cleanup(); RETURN
      END IF
      ! ...Write the predictors and interpolation weights
      WRITE( fid, IOSTAT=io_stat ) &
        NLTE_Predictor(m)%Tm       , &
        NLTE_Predictor(m)%Predictor, &
        NLTE_Predictor(m)%w        
      IF ( io_stat /= 0 ) THEN
        WRITE( msg,'("Error writing predictors and interpolation weights for profile ",i0, &
                    &". IOSTAT = ",i0)' ) m, io_stat
        CALL Write_Cleanup(); RETURN
      END IF

    END DO Profile_Loop
    

    ! Close the file
    CLOSE( fid, IOSTAT=io_stat )
    IF ( io_stat /= 0 ) THEN
      WRITE( msg,'("Error closing ",a,". IOSTAT = ",i0)' ) TRIM(Filename), io_stat
      CALL Write_Cleanup(); RETURN
    END IF


    ! Output an info message
    IF ( Noisy ) THEN
      WRITE( msg,'("Number of profiles written to ",a,": ",i0)' ) TRIM(Filename), n_output_profiles
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
    END IF

   CONTAINS
   
     SUBROUTINE Write_Cleanup()
       IF ( File_Open(Filename) ) THEN
         CLOSE( fid, IOSTAT=io_stat, STATUS=WRITE_ERROR_STATUS )
         IF ( io_stat /= 0 ) &
           msg = TRIM(msg)//'; Error closing output file during error cleanup.'
       END IF
       err_stat = FAILURE
       CALL Display_Message( ROUTINE_NAME, msg, err_stat )
     END SUBROUTINE Write_Cleanup

  END FUNCTION NLTE_Predictor_WriteFile


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       NLTE_Predictor_IOVersion
!
! PURPOSE:
!       Subroutine to return the module version information.
!
! CALLING SEQUENCE:
!       CALL NLTE_Predictor_IOVersion( Id )
!
! OUTPUT ARGUMENTS:
!       Id:   Character string containing the version Id information
!             for the module.
!             UNITS:      N/A
!             TYPE:       CHARACTER(*)
!             DIMENSION:  Scalar
!             ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE NLTE_Predictor_IOVersion( Id )
    CHARACTER(*), INTENT(OUT) :: Id
    Id = MODULE_VERSION_ID
  END SUBROUTINE NLTE_Predictor_IOVersion
  
END MODULE NLTE_Predictor_IO
