CRTM_MW_Land_SfcOptics.f90

Go to the documentation of this file.

!
! CRTM_MW_Land_SfcOptics
!
! Module to compute the surface optical properties for LAND surfaces at
! microwave frequencies required for determining the LAND surface
! contribution to the radiative transfer.
!
! This module is provided to allow developers to "wrap" their existing
! codes inside the provided functions to simplify integration into
! the main CRTM_SfcOptics module.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 23-Jun-2005
!                       paul.vandelst@noaa.gov
!

MODULE crtm_mw_land_sfcoptics

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds,               ONLY: fp
  USE message_handler,          ONLY: success, failure, display_message
  USE crtm_parameters,          ONLY: zero, one, max_n_angles
  USE crtm_spccoeff,            ONLY: sc
  USE crtm_surface_define,      ONLY: crtm_surface_type
  USE crtm_geometryinfo_define, ONLY: crtm_geometryinfo_type
  USE crtm_sfcoptics_define,    ONLY: crtm_sfcoptics_type
  USE nesdis_landem_module,     ONLY: nesdis_landem
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Data types
  PUBLIC :: ivar_type
  ! Science routines
  PUBLIC :: compute_mw_land_sfcoptics
  PUBLIC :: compute_mw_land_sfcoptics_tl
  PUBLIC :: compute_mw_land_sfcoptics_ad


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PRIVATE, PARAMETER :: module_version_id = &
  '$Id: CRTM_MW_Land_SfcOptics.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Message length
  INTEGER, PARAMETER :: ml = 256
  ! Valid type indices for the microwave land emissivity model
  ! ...The soil types
  INTEGER, PARAMETER :: n_valid_soil_types = 8
  INTEGER, PARAMETER :: invalid_soil    =  0
  INTEGER, PARAMETER :: coarse          =  1
  INTEGER, PARAMETER :: medium          =  2
  INTEGER, PARAMETER :: fine            =  3
  INTEGER, PARAMETER :: coarse_medium   =  4
  INTEGER, PARAMETER :: coarse_fine     =  5
  INTEGER, PARAMETER :: medium_fine     =  6
  INTEGER, PARAMETER :: coarse_med_fine =  7
  INTEGER, PARAMETER :: organic         =  8
  ! ...The vegetation types
  INTEGER, PARAMETER :: n_valid_vegetation_types       = 12
  INTEGER, PARAMETER :: invalid_vegetation             =  0
  INTEGER, PARAMETER :: broadleaf_evergreen_trees      =  1
  INTEGER, PARAMETER :: broadleaf_deciduous_trees      =  2
  INTEGER, PARAMETER :: broadleaf_needleleaf_trees     =  3
  INTEGER, PARAMETER :: needleleaf_evergreen_trees     =  4
  INTEGER, PARAMETER :: needleleaf_deciduous_trees     =  5
  INTEGER, PARAMETER :: broadleaf_trees_groundcover    =  6
  INTEGER, PARAMETER :: groundcover                    =  7
  INTEGER, PARAMETER :: groadleaf_shrubs_groundcover   =  8
  INTEGER, PARAMETER :: broadleaf_shrubs_bare_soil     =  9
  INTEGER, PARAMETER :: dwarf_trees_shrubs_groundcover = 10
  INTEGER, PARAMETER :: bare_soil                      = 11
  INTEGER, PARAMETER :: cultivations                   = 12


  ! --------------------------------------
  ! Structure definition to hold forward
  ! variables across FWD, TL, and AD calls
  ! --------------------------------------
  TYPE :: ivar_type
    PRIVATE
    INTEGER :: dummy = 0
  END TYPE ivar_type


CONTAINS



!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Land_SfcOptics
!
! PURPOSE:
!       Function to compute the surface emissivity and reflectivity at microwave
!       frequencies over a land surface.
!
!       This function is a wrapper for third party code.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Land_SfcOptics( &
!                        Surface     , &
!                        SensorIndex , &
!                        ChannelIndex, &
!                        SfcOptics     )
!
! INPUTS:
!       Surface:         CRTM_Surface structure containing the surface state
!                        data.
!                        UNITS:      N/A
!                        TYPE:       CRTM_Surface_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       GeometryInfo:    CRTM_GeometryInfo structure containing the
!                        view geometry information.
!                        UNITS:      N/A
!                        TYPE:       CRTM_GeometryInfo_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       SensorIndex:     Sensor index id. This is a unique index associated
!                        with a (supported) sensor used to access the
!                        shared coefficient data for a particular sensor.
!                        See the ChannelIndex argument.
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       ChannelIndex:    Channel index id. This is a unique index associated
!                        with a (supported) sensor channel used to access the
!                        shared coefficient data for a particular sensor's
!                        channel.
!                        See the SensorIndex argument.
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       SfcOptics:       CRTM_SfcOptics structure containing the surface
!                        optical properties required for the radiative
!                        transfer calculation. On input the Angle component
!                        is assumed to contain data.
!                        UNITS:      N/A
!                        TYPE:       CRTM_SfcOptics_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN 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 computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output SfcOptics argument is IN OUT rather
!       than just OUT as it is assumed to contain some data upon input.
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION compute_mw_land_sfcoptics( &
    Surface     , &  ! Input
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    SfcOptics   ) &  ! Output
  result( err_stat )
    ! Arguments
    TYPE(crtm_surface_type),      INTENT(IN)     :: surface
    INTEGER,                      INTENT(IN)     :: sensorindex
    INTEGER,                      INTENT(IN)     :: channelindex
    TYPE(crtm_sfcoptics_type),    INTENT(IN OUT) :: sfcoptics
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Compute_MW_Land_SfcOptics'
    REAL(fp),     PARAMETER :: frequency_cutoff   = 80.0_fp  ! GHz
    REAL(fp),     PARAMETER :: default_emissivity = 0.95_fp
    ! Local variables
    CHARACTER(ML) :: msg
    INTEGER :: i


    ! Set up
    err_stat = success
    ! ...Check the soil type...
    IF ( surface%Soil_Type < 1 .OR. &
         surface%Soil_Type > n_valid_soil_types ) THEN
      sfcoptics%Emissivity   = zero
      sfcoptics%Reflectivity = zero
      err_stat = failure
      msg = 'Invalid soil type index specified'
      CALL display_message( routine_name, msg, err_stat ); RETURN
    END IF
    ! ...and the vegetation type
    IF ( surface%Vegetation_Type < 1 .OR. &
         surface%Vegetation_Type > n_valid_vegetation_types ) THEN
      sfcoptics%Emissivity   = zero
      sfcoptics%Reflectivity = zero
      err_stat = failure
      msg = 'Invalid vegetation type index specified'
      CALL display_message( routine_name, msg, err_stat ); RETURN
    END IF


    ! Compute the surface optical parameters
    IF ( sc(sensorindex)%Frequency(channelindex) < frequency_cutoff ) THEN
      ! Frequency is low enough for the model
      DO i = 1, sfcoptics%n_Angles
        CALL nesdis_landem(sfcoptics%Angle(i),            & ! Input, Degree
                           sc(sensorindex)%Frequency(channelindex),   & ! Input, GHz
                           surface%Soil_Moisture_Content, & ! Input, g.cm^-3
                           surface%Vegetation_Fraction,   & ! Input
                           surface%Soil_Temperature,      & ! Input, K
                           surface%Land_Temperature,      & ! Input, K
                           surface%Lai,                   & ! Input, Leaf Area Index
                           surface%Soil_Type,             & ! Input, Soil Type (1 -  9)
                           surface%Vegetation_Type,       & ! Input, Vegetation Type (1 - 13)
                           zero,                          & ! Input, Snow depth, mm
                           sfcoptics%Emissivity(i,2),     & ! Output, H component
                           sfcoptics%Emissivity(i,1)      ) ! Output, V component
        ! Assume specular surface
        sfcoptics%Reflectivity(i,1,i,1) = one-sfcoptics%Emissivity(i,1)
        sfcoptics%Reflectivity(i,2,i,2) = one-sfcoptics%Emissivity(i,2)
      END DO
    ELSE
      ! Frequency is too high for model. Use default.
      DO i = 1, sfcoptics%n_Angles
        sfcoptics%Emissivity(i,1:2)         = default_emissivity
        sfcoptics%Reflectivity(i,1:2,i,1:2) = one-default_emissivity
      END DO
    END IF

  END FUNCTION compute_mw_land_sfcoptics


!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Land_SfcOptics_TL
!
! PURPOSE:
!       Function to compute the tangent-linear surface emissivity and
!       reflectivity at microwave frequencies over a land surface.
!
!       This function is a wrapper for third party code.
!
!       NB: CURRENTLY THIS IS A STUB FUNCTION AS THERE ARE NO TL
!           COMPONENTS IN THE MW LAND SFCOPTICS COMPUTATIONS.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Land_SfcOptics_TL( SfcOptics_TL )
!
! OUTPUTS:
!       SfcOptics_TL:    Structure containing the tangent-linear surface
!                        optical properties required for the tangent-
!                        linear radiative transfer calculation.
!                        UNITS:      N/A
!                        TYPE:       CRTM_SfcOptics_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN 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 computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the output SfcOptics_TL argument is IN OUT rather
!       than just OUT. This is necessary because the argument may be defined
!       upon input.
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION compute_mw_land_sfcoptics_tl( &
    SfcOptics_TL) &  ! TL  Output
  result( err_stat )
    ! Arguments
    TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics_tl
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Compute_MW_Land_SfcOptics_TL'
    ! Local variables


    ! Set up
    err_stat = success


    ! Compute the tangent-linear surface optical parameters
    ! ***No TL models yet, so default TL output is zero***
    sfcoptics_tl%Reflectivity = zero
    sfcoptics_tl%Emissivity   = zero

  END FUNCTION compute_mw_land_sfcoptics_tl



!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Land_SfcOptics_AD
!
! PURPOSE:
!       Function to compute the adjoint surface emissivity and
!       reflectivity at microwave frequencies over a land surface.
!
!       This function is a wrapper for third party code.
!
!       NB: CURRENTLY THIS IS A STUB FUNCTION AS THERE ARE NO AD
!           COMPONENTS IN THE MW LAND SFCOPTICS COMPUTATIONS.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Land_SfcOptics_AD( SfcOptics_AD )
!
! INPUTS:
!       SfcOptics_AD:    Structure containing the adjoint surface optical
!                        properties required for the adjoint radiative
!                        transfer calculation.
!                        *** COMPONENTS MODIFIED UPON OUTPUT ***
!                        UNITS:      N/A
!                        TYPE:       CRTM_SfcOptics_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN 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 computation was sucessful
!                           == FAILURE an unrecoverable error occurred
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Scalar
!
! COMMENTS:
!       Note the INTENT on the input adjoint arguments are IN OUT regardless
!       of their specification as "input" or "output". This is because these
!       arguments may contain information on input, or need to be zeroed on
!       output (or both).
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION compute_mw_land_sfcoptics_ad( &
    SfcOptics_AD) &  ! AD  Input
  result( err_stat )
    ! Arguments
    TYPE(crtm_sfcoptics_type),    INTENT(IN OUT) :: sfcoptics_ad
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Compute_MW_Land_SfcOptics_AD'
    ! Local variables


    ! Set up
    err_stat = success


    ! Compute the adjoint surface optical parameters
    ! ***No AD models yet, so there is no impact on AD result***
    sfcoptics_ad%Reflectivity = zero
    sfcoptics_ad%Emissivity   = zero

  END FUNCTION compute_mw_land_sfcoptics_ad

END MODULE crtm_mw_land_sfcoptics