ODSSU_TauCoeff.f90

Go to the documentation of this file.

!
! ODSSU_TauCoeff
!
! Module containing the shared absorption coefficients (TauCoeff)
! and their load/destruction routines for the ODSSU algorithm
!
! PUBLIC DATA:
!       TC:  Data structure array containing the transmittance model
!            coefficient data for the requested sensors.
!
! SIDE EFFECTS:
!       Routines in this module modify the contents of the public
!       data structure TC.
!
! RESTRICTIONS:
!       Routines in this module should only be called during the
!       CRTM initialisation.
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 12-Jun-2000
!                       paul.vandelst@ssec.wisc.edu
!
!       Modifed by:     Yong Han, NESDIS/STAR 26-June-2008
!                       yong.han@noaa.gov
!
MODULE odssu_taucoeff

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE message_handler   , ONLY: success, failure, warning, display_message
  USE odssu_define      , ONLY: odssu_taucoeff_type    => odssu_type, &          
                                odssu_destroy_taucoeff => destroy_odssu        
  USE odssu_binary_io   , ONLY: read_taucoeff_binary   => read_odssu_binary
  USE crtm_parameters   , ONLY: max_n_sensors           , &
                                crtm_set_max_nchannels  , &
                                crtm_reset_max_nchannels, &
                                crtm_get_max_nchannels  , &
                                crtm_isset_max_nchannels
  ! Disable all implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! The shared data
  PUBLIC :: tc
  ! Structure defined in ODSSU_Define
  PUBLIC :: odssu_taucoeff_type
  ! Public routines in this module
  PUBLIC :: load_taucoeff
  PUBLIC :: destroy_taucoeff


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*),  PARAMETER, PRIVATE :: module_rcs_id = &
  '$Id: ODSSU_TauCoeff.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'


  ! --------------------------------------
  ! The shared data for the gas absorption
  ! (AtmAbsorption) model
  ! --------------------------------------
  TYPE(odssu_taucoeff_type), SAVE, ALLOCATABLE, TARGET :: tc(:)


CONTAINS


!------------------------------------------------------------------------------
!
! NAME:
!       Load_TauCoeff
!
! PURPOSE:
!       Function to load the TauCoeff transmittance coefficient data into
!       the shared data structure.
!
! CALLING SEQUENCE:
!       Error_Status = Load_TauCoeff( Sensor_ID        =Sensor_ID,         &  ! Optional input
!                                     File_Path        =File_Path,         &  ! Optional input      
!                                     Quiet            =Quiet,             &  ! Optional input      
!                                     Process_ID       =Process_ID,        &  ! Optional input      
!                                     Output_Process_ID=Output_Process_ID, &  ! Optional input      
!                                     Message_Log      =Message_Log        )  ! Error messaging     
!
! OPTIONAL INPUT ARGUMENTS:
!       Sensor_ID:          List of the sensor IDs (e.g. hirs3_n17, amsua_n18,
!                           ssmis_f16, etc) with which the CRTM is to be
!                           initialised. These Sensor ID are used to construct
!                           the sensor specific TauCoeff filenames containing
!                           the necessary coefficient data, i.e.
!                             <Sensor_ID>.TauCoeff.bin
!                           If this argument is not specified, the default
!                           TauCoeff filename is
!                             TauCoeff.bin
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           DIMENSION:  Rank-1
!                           ATTRIBUTES: INTENT(IN)
!
!       File_Path:          Character string specifying a file path for the
!                           input data files. If not specified, the current
!                           directory is the default.
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Quiet:              Set this argument to suppress INFORMATION messages
!                           being printed to standard output (or the message
!                           log file if the Message_Log optional argument is
!                           used.) By default, INFORMATION messages are printed.
!                           If QUIET = 0, INFORMATION messages are OUTPUT.
!                              QUIET = 1, INFORMATION messages are SUPPRESSED.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Process_ID:         Set this argument to the MPI process ID that this
!                           function call is running under. This value is used
!                           solely for controlling INFORMATIOn message output.
!                           If MPI is not being used, ignore this argument.
!                           This argument is ignored if the Quiet argument is set.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Output_Process_ID:  Set this argument to the MPI process ID in which
!                           all INFORMATION messages are to be output. If
!                           the passed Process_ID value agrees with this value
!                           the INFORMATION messages are output. 
!                           This argument is ignored if the Quiet argument
!                           is set.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Message_Log:        Character string specifying a filename in which
!                           any messages will be logged. If not specified,
!                           or if an error occurs opening the log file, the
!                           default action is to output messages to standard
!                           output.
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           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 TauCoeff data load was successful
!                              == FAILURE an unrecoverable error occurred.
!                              == WARNING the number of channels read in differs
!                                         from that stored in the CRTM_Parameters
!                                         module.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!
! SIDE EFFECTS:
!       This function modifies the contents of the public data structures
!       in this module.
!
!------------------------------------------------------------------------------

  FUNCTION load_taucoeff( Sensor_ID        , &  ! Input
                          File_Path        , &  ! Optional input      
                          Quiet            , &  ! Optional input      
                          Process_ID       , &  ! Optional input      
                          Output_Process_ID, &  ! Optional input      
                          Message_Log      ) &  ! Error messaging     
                        result( error_status )                        
    ! Arguments
    CHARACTER(*), DIMENSION(:), OPTIONAL, INTENT(IN) :: sensor_id
    CHARACTER(*),               OPTIONAL, INTENT(IN) :: file_path
    INTEGER,                    OPTIONAL, INTENT(IN) :: quiet
    INTEGER,                    OPTIONAL, INTENT(IN) :: process_id
    INTEGER,                    OPTIONAL, INTENT(IN) :: output_process_id
    CHARACTER(*),               OPTIONAL, INTENT(IN) :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Load_TauCoeff'
    ! Local variables
    CHARACTER(256) :: message
    CHARACTER(256) :: process_id_tag
    CHARACTER(256), DIMENSION(MAX_N_SENSORS) :: taucoeff_file
    INTEGER :: allocate_status
    INTEGER :: n, n_sensors

    ! Set up
    error_status = success
    ! Create a process ID message tag for
    ! WARNING and FAILURE messages
    IF ( PRESENT(process_id) ) THEN
      WRITE( process_id_tag, '(";  MPI Process ID: ",i0)' ) process_id
    ELSE
      process_id_tag = ' '
    END IF

    ! Determine the number of sensors and construct their filenames
    IF ( PRESENT(sensor_id) ) THEN
      ! Construct filenames for specified sensors
      n_sensors = SIZE(sensor_id)
      IF ( n_sensors > max_n_sensors ) THEN
        error_status = failure
        WRITE(message,'("Too many sensors, ",i0," specified. Maximum of ",i0," sensors allowed.")') &
                      n_sensors, max_n_sensors
        CALL display_message( routine_name, &
                              trim(message)//trim(process_id_tag), &
                              error_status, &
                              message_log=message_log)
        RETURN
      END IF
      DO n=1,n_sensors
        taucoeff_file(n) = trim(adjustl(sensor_id(n)))//'.TauCoeff.bin'
      END DO
    ELSE
      ! No sensors specified. Use default filename.
      n_sensors=1
      taucoeff_file(1) = 'TauCoeff.bin'
    END IF
    
    ! Add the file path
    IF ( PRESENT(file_path) ) THEN
      DO n=1,n_sensors
        taucoeff_file(n) = trim(adjustl(file_path))//trim(taucoeff_file(n))
      END DO
    END IF
    
    ! Allocate the TauCoeff shared data structure array
    ALLOCATE(tc(n_sensors), stat=allocate_status)
    IF( allocate_status /= 0 )THEN
      WRITE(message,'("TauCoeff structure array allocation failed. STAT=",i0)') allocate_status
      error_status = failure
      CALL display_message( routine_name, &
                            trim(message)//trim(process_id_tag), & 
                            error_status, &
                            message_log = message_log )
      RETURN
    END IF
    
    ! Read the TauCoeff data files
    DO n = 1, n_sensors
      error_status = read_taucoeff_binary( trim(taucoeff_file(n))             , &  ! Input
                                           tc(n)                              , &  ! Output
                                           quiet            =quiet            , &
                                           process_id       =process_id       , &
                                           output_process_id=output_process_id, &
                                           message_log      =message_log        )
      IF ( error_status /= success ) THEN
        WRITE(message,'("Error reading TauCoeff file #",i0,", ",a)') &
                      n, trim(taucoeff_file(n))
        CALL display_message( routine_name, &
                              trim(message)//trim(process_id_tag), &
                              error_status, &
                              message_log=message_log )
        RETURN
      END IF
    END DO

  END FUNCTION load_taucoeff 


!------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Destroy_TauCoeff
!
! PURPOSE:
!       Function to deallocate the public shared data structure containing
!       the CRTM TauCoeff transmittance coefficient data.
!
! CALLING SEQUENCE:
!       Error_Status = Destroy_TauCoeff( Process_ID  = Process_ID, &  ! Optional input
!                                        Message_Log = Message_Log )  ! Error messaging
!
! OPTIONAL INPUT ARGUMENTS:
!       Process_ID:       Set this argument to the MPI process ID that this
!                         function call is running under. This value is used
!                         solely for controlling message output. If MPI is not
!                         being used, ignore this argument.
!                         UNITS:      N/A
!                         TYPE:       INTEGER
!                         DIMENSION:  Scalar
!                         ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Message_Log:      Character string specifying a filename in which any
!                         messages will be logged. If not specified, or if an
!                         error occurs opening the log file, the default action
!                         is to output messages to the screen.
!                         UNITS:      N/A
!                         TYPE:       CHARACTER(*)
!                         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 deallocation of the public TC data
!                                       structure was successful
!                            == FAILURE an unrecoverable error occurred.
!                         UNITS:      N/A
!                         TYPE:       INTEGER
!                         DIMENSION:  Scalar
!
!
! SIDE EFFECTS:
!       This function modifies the contents of the public data structures
!       in this module.
!
!------------------------------------------------------------------------------

  FUNCTION destroy_taucoeff( Process_ID,   &  ! Optional input
                             Message_Log ) &  ! Error messaging     
                           result( error_status )                   
    ! Arguments
    INTEGER,      OPTIONAL, INTENT(IN)  :: process_id
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: message_log
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Destroy_TauCoeff'
    ! Local variables
    CHARACTER(256) :: message
    CHARACTER(256) :: process_id_tag
    INTEGER :: n, destroy_status, allocate_status
    
    ! Set up
    error_status = success
    ! Create a process ID message tag for
    ! WARNING and FAILURE messages
    IF ( PRESENT( process_id ) ) THEN
      WRITE( process_id_tag, '(";  MPI Process ID: ",i0)' ) process_id
    ELSE
      process_id_tag = ' '
    END IF

    ! Destroy the structure array elements
    DO n = 1, SIZE(tc)
      destroy_status = odssu_destroy_taucoeff( tc(n), &
                                               message_log=message_log )
      IF ( destroy_status /= success ) THEN
        error_status = failure
        WRITE(message,'("Error destroying TauCoeff structure array element #",i0)') n
        CALL display_message( routine_name, &
                              trim(message)//trim(process_id_tag), &
                              error_status, &
                              message_log=message_log )
        ! No return here. Continue deallocating
      END IF
    END DO

    ! Deallocate the structure array
    DEALLOCATE(tc, stat=allocate_status)
    IF( allocate_status /= 0 )THEN
      WRITE(message,'("RTTOV TC structure deallocation failed. STAT=",i0)') allocate_status
      error_status = failure
      CALL display_message( routine_name, &
                            trim(message)//trim(process_id_tag), &
                            error_status, &
                            message_log=message_log)
      
      ! Again, no return.
    END IF

    ! Reset the protected variable Max_n_Channels
    CALL crtm_reset_max_nchannels()

  END FUNCTION destroy_taucoeff

END MODULE odssu_taucoeff