CRTM_MW_Snow_SfcOptics.f90

Go to the documentation of this file.

!
! CRTM_MW_Snow_SfcOptics
!
! Module to compute the surface optical properties for SNOW surfaces at
! microwave frequencies required for determining the SNOW 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
!
!       Modified by:    Banghua Yan, 03-Oct-2007
!                       Banghua.Yan@noaa.gov
!
!       Modified by:    Yong Chen. 09-Jul-212
!                       Yong.Chen@noaa.gov

MODULE crtm_mw_snow_sfcoptics

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds,                 ONLY: fp
  USE message_handler,            ONLY: success
  USE crtm_parameters,            ONLY: zero, one
  USE crtm_spccoeff,              ONLY: sc
  USE crtm_surface_define,        ONLY: crtm_surface_type
  USE crtm_geometryinfo_define,   ONLY: crtm_geometryinfo_type, &
                                        crtm_geometryinfo_getvalue
  USE crtm_sfcoptics_define,      ONLY: crtm_sfcoptics_type
  USE crtm_sensorinfo,            ONLY: wmo_amsua, &
                                        wmo_amsub, &
                                        wmo_amsre, &
                                        wmo_ssmi , &
                                        wmo_msu  , &
                                        wmo_mhs  , &
                                        wmo_ssmis, &
                                        wmo_atms
  USE nesdis_landem_module,       ONLY: nesdis_landem
  USE nesdis_amsu_snowem_module,  ONLY: nesdis_amsu_snowem
  USE nesdis_ssmi_snowem_module,  ONLY: nesdis_ssmi_snowem
  USE nesdis_amsre_snowem_module, ONLY: nesdis_amsre_snow
  USE nesdis_mhs_snowem_module,   ONLY: nesdis_snowem_mhs
  USE nesdis_ssmis_snowem_module, ONLY: nesdis_ssmis_snowem
  USE nesdis_atms_snowem_module,  ONLY: nesdis_atms_snowem
  ! Disable implicit typing
  IMPLICIT NONE

  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Data types
  PUBLIC :: ivar_type
  ! Science routines
  PUBLIC :: compute_mw_snow_sfcoptics
  PUBLIC :: compute_mw_snow_sfcoptics_tl
  PUBLIC :: compute_mw_snow_sfcoptics_ad


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


  ! --------------------------------------
  ! 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_Snow_SfcOptics
!
! PURPOSE:
!       Function to compute the surface emissivity and reflectivity at microwave
!       frequencies over a snow surface.
!
!       This function is a wrapper for third party code.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Snow_SfcOptics( &
!                        Surface     , &
!                        GeometryInfo, &
!                        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_snow_sfcoptics( &
    Surface     , &  ! Input
    GeometryInfo, &  ! Input
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    SfcOptics   ) &  ! Output
  result( error_status )
    ! Arguments
    TYPE(crtm_surface_type),      INTENT(IN)     :: surface
    TYPE(crtm_geometryinfo_type), INTENT(IN)     :: geometryinfo
    INTEGER,                      INTENT(IN)     :: sensorindex
    INTEGER,                      INTENT(IN)     :: channelindex
    TYPE(crtm_sfcoptics_type),    INTENT(IN OUT) :: sfcoptics
    ! Function result
    INTEGER :: error_status
    ! Local parameters
    CHARACTER(*),  PARAMETER :: routine_name = 'Compute_MW_Snow_SfcOptics'
    REAL(fp), PARAMETER :: msu_snow_temperature_threshold = 100.0_fp  ! K
    REAL(fp), PARAMETER :: msu_tb_threshold               =  50.0_fp  ! K
    REAL(fp), PARAMETER :: msu_alpha_c                    =   0.35_fp
    REAL(fp), PARAMETER :: msu_emissivity_threshold       =   0.6_fp
    REAL(fp), PARAMETER :: msu_default_emissivity         =   0.855_fp
    REAL(fp), PARAMETER :: frequency_threshold            =  80.0_fp  ! GHz
    REAL(fp), PARAMETER :: default_emissivity             =   0.90_fp
    REAL(fp), PARAMETER :: not_used(4)                    = -99.9_fp
    INTEGER,  PARAMETER :: amsre_v_index(6) = (/1, 3, 5, 7, 9, 11/)  ! AMSRE channels with V pol.
    INTEGER,  PARAMETER :: amsre_h_index(6) = (/2, 4, 6, 8, 10, 12/) ! AMSRE channels with H pol.
    INTEGER,  PARAMETER :: amsua_index(4)   = (/1, 2, 3, 15/)
    INTEGER,  PARAMETER :: ssmis_index(8)   = (/13,12,14,16,15,17,18,8/)  ! With swapped polarisations
    INTEGER,  PARAMETER :: atms_index(5)    = (/1, 2, 3, 16,17/)          ! With mixed polarisations
    ! Local variables
    INTEGER :: i
    REAL(fp) :: sensor_zenith_angle
    REAL(fp) :: alpha


    ! Set up
    error_status = success
    CALL crtm_geometryinfo_getvalue( geometryinfo, sensor_zenith_angle = sensor_zenith_angle )


    ! Compute the surface emissivities
    sensor_type: SELECT CASE( surface%SensorData%WMO_Sensor_ID )

      ! ATMSemissivity model
      CASE( wmo_atms )    
         DO i = 1, sfcoptics%n_Angles
          CALL nesdis_atms_snowem( sensor_zenith_angle,                     &  ! Input, Degree           
                                   sfcoptics%Angle(i),                      &  ! Input, Degree           
                                   sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz                  
                                   surface%SensorData%Tb(atms_index),       &  ! Input, ATMS           
                                   surface%Snow_Temperature,                &  ! Input, K                
                                   surface%Snow_Depth,                      &  ! Input, mm               
                                   sfcoptics%Emissivity(i,2),               &  ! Output, H component      
                                   sfcoptics%Emissivity(i,1)   )               ! Output, V component 
         END DO                                                                                           


      ! AMSU-A emissivity model
      CASE( wmo_amsua )
        DO i = 1, sfcoptics%n_Angles
          CALL nesdis_amsu_snowem( sensor_zenith_angle,                     &  ! Input, Degree
                                   sfcoptics%Angle(i),                      &  ! Input, Degree
                                   sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz
                                   surface%Snow_Depth,                      &  ! Input, mm
                                   surface%Snow_Temperature,                &  ! Input, K
                                   surface%SensorData%Tb(amsua_index),      &  ! Input, AMSUA
                                   not_used(1:2),                           &  ! Input, AMSUB  *** NO AMSU-B DATA ***
                                   sfcoptics%Emissivity(i,2),               &  ! Output, H component
                                   sfcoptics%Emissivity(i,1)                )  ! Output, V component
        END DO

      ! AMSU-B emissivity model
      CASE( wmo_amsub)
        DO i = 1, sfcoptics%n_Angles
          CALL nesdis_amsu_snowem( sensor_zenith_angle,                     &  ! Input, Degree
                                   sfcoptics%Angle(i),                      &  ! Input, Degree
                                   sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz
                                   surface%Snow_Depth,                      &  ! Input, mm
                                   surface%Snow_Temperature,                &  ! Input, K
                                   not_used,                                &  ! Input  AMSUA  *** NO AMSU-A DATA ***
                                   surface%SensorData%Tb(1:2),              &  ! Input, AMSUB
                                   sfcoptics%Emissivity(i,2),               &  ! Output, H component
                                   sfcoptics%Emissivity(i,1)                )  ! Output, V component
        END DO

      ! MHS emissivity model
      CASE (wmo_mhs)
        DO i = 1, sfcoptics%n_Angles
          CALL nesdis_snowem_mhs( sensor_zenith_angle,                     &  ! Input, Degree
                                  sfcoptics%Angle(i),                      &  ! Input, Degree
                                  sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz
                                  surface%Snow_Temperature,                &  ! Input, K
                                  surface%SensorData%Tb(1:2),              &  ! Input, AMSUB
                                  sfcoptics%Emissivity(i,2),               &  ! Output, H component
                                  sfcoptics%Emissivity(i,1)                )  ! Output, V component
        END DO

      ! AMSR-E emissivity model
      CASE( wmo_amsre )
        DO i = 1, sfcoptics%n_Angles
          CALL nesdis_amsre_snow(sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz
                                 sfcoptics%Angle(i),                      &  ! Input, Degree
                                 surface%SensorData%Tb(amsre_v_index),    &  ! Input, Tb_V, K
                                 surface%SensorData%Tb(amsre_h_index),    &  ! Input, Tb_H, K
                                 surface%Snow_Temperature,                &  ! Input, Ts, K
                                 surface%Snow_Temperature,                &  ! Input, Tsnow, K
                                 sfcoptics%Emissivity(i,2),               &  ! Output, H component
                                 sfcoptics%Emissivity(i,1)                )  ! Output, V component
        END DO

      ! SSM/I emissivity model
      CASE( wmo_ssmi )
        DO i = 1, sfcoptics%n_Angles
          CALL nesdis_ssmi_snowem(sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz
                                  sfcoptics%Angle(i),                      &  ! Input, Degree
                                  surface%Snow_Temperature,                &  ! Input, K
                                  surface%SensorData%Tb,                   &  ! Input, K
                                  surface%Snow_Depth,                      &  ! Input, mm
                                  sfcoptics%Emissivity(i,2),               &  ! Output, H component
                                  sfcoptics%Emissivity(i,1)                )  ! Output, V component
        END DO

      ! SSMIS emissivity model
      CASE( wmo_ssmis )
        DO i = 1, sfcoptics%n_Angles
          CALL nesdis_ssmis_snowem(sc(sensorindex)%Frequency(channelindex), &  ! Input, GHz
                                   sfcoptics%Angle(i),                      &  ! Input, Degree
                                   surface%Snow_Temperature,                &  ! Input, K
                                   surface%SensorData%Tb(ssmis_index),      &  ! Input, K
                                   surface%Snow_Depth,                      &  ! Input, mm
                                   sfcoptics%Emissivity(i,2),               &  ! Output, H component
                                   sfcoptics%Emissivity(i,1)                )  ! Output, V component
        END DO

      ! MSU emissivity model
      CASE( wmo_msu )
        DO i = 1, sfcoptics%n_Angles
          IF( surface%Snow_Temperature > msu_snow_temperature_threshold .AND. &
              surface%SensorData%Tb(1) > msu_tb_threshold                     ) THEN
            alpha = msu_alpha_c * surface%Snow_Temperature
            sfcoptics%Emissivity(i,1) = (surface%SensorData%Tb(1)-alpha)/&
                                        (surface%Snow_Temperature-alpha)
            IF( sfcoptics%Emissivity(i,1) > one ) &
              sfcoptics%Emissivity(i,1) = one
            IF( sfcoptics%Emissivity(i,1) < msu_emissivity_threshold ) &
              sfcoptics%Emissivity(i,1) = msu_emissivity_threshold
          ELSE
            sfcoptics%Emissivity(i,1) = msu_default_emissivity
          END IF
          sfcoptics%Emissivity(i,2) = sfcoptics%Emissivity(i,1)
        END DO

      ! Default physical model
      CASE DEFAULT
        IF ( sc(sensorindex)%Frequency(channelindex) < frequency_threshold ) THEN
          DO i = 1, sfcoptics%n_Angles
            CALL nesdis_landem( sfcoptics%Angle(i),                      & ! Input, Degree
                                sc(sensorindex)%Frequency(channelindex), & ! Input, GHz
                                not_used(1),                             & ! Input, Soil_Moisture_Content, g.cm^-3
                                not_used(1),                             & ! Input, Vegetation_Fraction
                                surface%Snow_Temperature,                & ! Input, K
                                surface%Snow_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)
                                surface%Snow_Depth,                      & ! Input, mm
                                sfcoptics%Emissivity(i,2),               & ! Output, H component
                                sfcoptics%Emissivity(i,1)                ) ! Output, V component
          END DO
        ELSE
          sfcoptics%Emissivity(1:sfcoptics%n_Angles,1:2) = default_emissivity
        END IF

    END SELECT sensor_type


    ! Compute the surface reflectivities,
    ! assuming a specular surface
    sfcoptics%Reflectivity = zero
    DO i = 1, sfcoptics%n_Angles
      sfcoptics%Reflectivity(i,1,i,1) = one-sfcoptics%Emissivity(i,1)
      sfcoptics%Reflectivity(i,2,i,2) = one-sfcoptics%Emissivity(i,2)
    END DO

  END FUNCTION compute_mw_snow_sfcoptics


!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Snow_SfcOptics_TL
!
! PURPOSE:
!       Function to compute the tangent-linear surface emissivity and
!       reflectivity at microwave frequencies over a snow 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 SNOW SFCOPTICS COMPUTATIONS.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Snow_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_snow_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_Snow_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_snow_sfcoptics_tl



!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Snow_SfcOptics_AD
!
! PURPOSE:
!       Function to compute the adjoint surface emissivity and
!       reflectivity at microwave frequencies over a snow 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 SNOW SFCOPTICS COMPUTATIONS.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Snow_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_snow_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_Snow_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_snow_sfcoptics_ad

END MODULE crtm_mw_snow_sfcoptics