CRTM_MW_Water_SfcOptics.f90

Go to the documentation of this file.

!
! CRTM_MW_Water_SfcOptics
!
! Module to compute the surface optical properties for WATER surfaces at
! microwave frequencies required for determining the WATER 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, 25-Jun-2005
!                       paul.vandelst@noaa.gov
!

MODULE crtm_mw_water_sfcoptics

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds,               ONLY: fp
  USE message_handler,          ONLY: success
  USE crtm_parameters,          ONLY: set, not_set, &
                                      zero, one, &
                                      max_n_angles, &
                                      n_stokes => max_n_stokes
  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_lowfrequency_mwssem, ONLY: lf_mwssem_type => ivar_type, &
                                      lowfrequency_mwssem, &
                                      lowfrequency_mwssem_tl, &
                                      lowfrequency_mwssem_ad
  USE crtm_fastem1,             ONLY: fastem1
  USE crtm_fastemx,             ONLY: fastemx_type => ivar_type, &
                                      compute_fastemx,   &
                                      compute_fastemx_tl,&
                                      compute_fastemx_ad
  USE crtm_mwwatercoeff       , ONLY: mwwaterc
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Data types
  PUBLIC :: ivar_type
  ! Science routines
  PUBLIC :: compute_mw_water_sfcoptics
  PUBLIC :: compute_mw_water_sfcoptics_tl
  PUBLIC :: compute_mw_water_sfcoptics_ad


  ! -----------------
  ! Module parameters
  ! -----------------
  ! RCS Id for the module
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: CRTM_MW_Water_SfcOptics.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Low frequency model threshold
  REAL(fp), PARAMETER :: low_f_threshold = 20.0_fp ! GHz


  ! --------------------------------------
  ! Structure definition to hold forward
  ! variables across FWD, TL, and AD calls
  ! --------------------------------------
  TYPE :: ivar_type
    PRIVATE
    ! FastemX model internal variable structure
    TYPE(fastemx_type) :: fastemx_var
    ! Low frequency model internal variable structure
    TYPE(lf_mwssem_type) :: lf_mwssem_var
    ! Fastem outputs
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: deh_dts        = zero
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: deh_dwindspeed = zero
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: dev_dts        = zero
    REAL(fp), DIMENSION(MAX_N_ANGLES) :: dev_dwindspeed = zero
  END TYPE ivar_type

CONTAINS



!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Water_SfcOptics
!
! PURPOSE:
!       Function to compute the surface emissivity and reflectivity at microwave
!       frequencies over a water surface.
!
!       This function is a wrapper for third party code.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Water_SfcOptics( Surface     , &  ! Input
!                                                  GeometryInfo, &  ! Input
!                                                  SensorIndex , &  ! Input
!                                                  ChannelIndex, &  ! Input
!                                                  SfcOptics   , &  ! Output
!                                                  iVar          )  ! Internal variable output
!
! 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)
!
!       iVar:            Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: 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 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_water_sfcoptics( &
    Surface     , &  ! Input
    GeometryInfo, &  ! Input
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    SfcOptics   , &  ! Output
    iVar        ) &  ! Internal variable output
  result( err_stat )
    ! 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
    TYPE(ivar_type),              INTENT(IN OUT) :: ivar
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Compute_MW_Water_SfcOptics'
    ! Local variables
    INTEGER  :: i, j
    REAL(fp) :: frequency
    REAL(fp) :: source_azimuth_angle, sensor_azimuth_angle
    REAL(fp) :: reflectivity(n_stokes)


    ! Set up
    err_stat = success
    sfcoptics%Reflectivity = zero
    ! ...Retrieve data from structures
    frequency = sc(sensorindex)%Frequency(channelindex)
    CALL crtm_geometryinfo_getvalue( &
           geometryinfo, &
           source_azimuth_angle = source_azimuth_angle, &
           sensor_azimuth_angle = sensor_azimuth_angle  )


    ! Compute the surface optical parameters
    IF( sfcoptics%Use_New_MWSSEM ) THEN

      ! FastemX model
      sfcoptics%Azimuth_Angle = surface%Wind_Direction - sensor_azimuth_angle
      DO i = 1, sfcoptics%n_Angles
        CALL compute_fastemx( &
               mwwaterc                               , &  ! Input model coefficients
               frequency                              , &  ! Input
               sfcoptics%Angle(i)                     , &  ! Input
               surface%Water_Temperature              , &  ! Input
               surface%Salinity                       , &  ! Input
               surface%Wind_Speed                     , &  ! Input
               ivar%FastemX_Var                       , &  ! Internal variable output
               sfcoptics%Emissivity(i,:)              , &  ! Output
               reflectivity                           , &  ! Output
               azimuth_angle = sfcoptics%Azimuth_Angle, &  ! Optional input
               transmittance = sfcoptics%Transmittance  )  ! Optional input
        DO j = 1, n_stokes
          sfcoptics%Reflectivity(i,j,i,j) = reflectivity(j)
        END DO
      END DO

    ELSE

      ! Low frequency model coupled with Fastem1
      IF( frequency < low_f_threshold ) THEN
        ! Call the low frequency model
        DO i = 1, sfcoptics%n_Angles
          CALL lowfrequency_mwssem( &
                 frequency                , &  ! Input
                 sfcoptics%Angle(i)       , &  ! Input
                 surface%Water_Temperature, &  ! Input
                 surface%Salinity         , &  ! Input
                 surface%Wind_Speed       , &  ! Input
                 sfcoptics%Emissivity(i,:), &  ! Output
                 ivar%LF_MWSSEM_Var         )  ! Internal variable output
          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
        ! Call Fastem1
        DO i = 1, sfcoptics%n_Angles
          CALL fastem1( frequency                , & ! Input
                        sfcoptics%Angle(i)       , & ! Input
                        surface%Water_Temperature, & ! Input
                        surface%Wind_Speed       , & ! Input
                        sfcoptics%Emissivity(i,:), & ! Output
                        ivar%dEH_dWindSpeed(i)   , & ! Output
                        ivar%dEV_dWindSpeed(i)     ) ! Output
          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 IF

    END IF

  END FUNCTION compute_mw_water_sfcoptics


!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Compute_MW_Water_SfcOptics_TL
!
! PURPOSE:
!       Function to compute the tangent-linear surface emissivity and
!       reflectivity at microwave frequencies over a water surface.
!
!       This function is a wrapper for third party code.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Water_SfcOptics_TL( Surface     , &  ! Input
!                                                     SfcOptics   , &  ! Input
!                                                     Surface_TL  , &  ! Input
!                                                     GeometryInfo, &  ! Input
!                                                     SensorIndex , &  ! Input
!                                                     ChannelIndex, &  ! Output
!                                                     SfcOptics_TL, &  ! Output
!                                                     iVar          )  ! Internal variable input
!
! INPUTS:
!       Surface:         CRTM_Surface structure containing the surface state
!                        data.
!                        UNITS:      N/A
!                        TYPE:       CRTM_Surface_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       Surface_TL:      CRTM_Surface structure containing the tangent-linear
!                        surface state data.
!                        UNITS:      N/A
!                        TYPE:       CRTM_Surface_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       SfcOptics:       CRTM_SfcOptics structure containing the surface
!                        optical properties required for the radiative
!                        transfer calculation.
!                        UNITS:      N/A
!                        TYPE:       CRTM_SfcOptics_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)
!
!       iVar:            Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       SfcOptics_TL:    CRTM_SfcOptics structure containing the tangent-linear
!                        surface optical properties required for the tangent-
!                        linear radiative transfer calculation.
!                        UNITS:      N/A
!                        TYPE:       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. To prevent memory leaks, the IN OUT INTENT is a must.
!
!:sdoc-:
!----------------------------------------------------------------------------------

  FUNCTION compute_mw_water_sfcoptics_tl( &
    SfcOptics   , &  ! Input
    Surface_TL  , &  ! Input
    GeometryInfo, &  ! Input
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    SfcOptics_TL, &  ! Output
    iVar        ) &  ! Internal variable input
  result( err_stat )
    ! Arguments
    TYPE(crtm_surface_type),      INTENT(IN)     :: surface_tl
    TYPE(crtm_sfcoptics_type),    INTENT(IN)     :: sfcoptics
    TYPE(crtm_geometryinfo_type), INTENT(IN)     :: geometryinfo
    INTEGER,                      INTENT(IN)     :: sensorindex
    INTEGER,                      INTENT(IN)     :: channelindex
    TYPE(crtm_sfcoptics_type),    INTENT(IN OUT) :: sfcoptics_tl
    TYPE(ivar_type),              INTENT(IN)     :: ivar
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Compute_MW_Water_SfcOptics_TL'
    ! Local variables
    INTEGER :: i, j
    REAL(fp) :: frequency
    REAL(fp) :: source_azimuth_angle, sensor_azimuth_angle
    REAL(fp) :: reflectivity_tl(n_stokes)


    ! Set up
    err_stat = success
    sfcoptics_tl%Reflectivity = zero
    ! ...Retrieve data from structures
    frequency = sc(sensorindex)%Frequency(channelindex)
    CALL crtm_geometryinfo_getvalue( &
           geometryinfo, &
           source_azimuth_angle = source_azimuth_angle, &
           sensor_azimuth_angle = sensor_azimuth_angle  )


    ! Compute the tangent-linear surface optical parameters
    IF( sfcoptics%Use_New_MWSSEM ) THEN

      ! FastemX model
      DO i = 1, sfcoptics%n_Angles
        CALL compute_fastemx_tl( &
               mwwaterc                                    , &  ! Input model coefficients
               surface_tl%Water_Temperature                , &  ! TL Input
               surface_tl%Salinity                         , &  ! TL Input
               surface_tl%Wind_Speed                       , &  ! TL Input
               ivar%FastemX_Var                            , &  ! Internal variable input
               sfcoptics_tl%Emissivity(i,:)                , &  ! TL Output
               reflectivity_tl                             , &  ! TL Output
               azimuth_angle_tl = surface_tl%Wind_Direction, &  ! Optional TL input
               transmittance_tl = sfcoptics_tl%Transmittance )  ! Optional TL input
        DO j = 1, n_stokes
          sfcoptics_tl%Reflectivity(i,j,i,j) = reflectivity_tl(j)
        END DO
      END DO

    ELSE

      ! Low frequency model coupled with Fastem1
      IF( frequency < low_f_threshold ) THEN
        ! Call the low frequency model
        DO i = 1, sfcoptics%n_Angles
          CALL lowfrequency_mwssem_tl( &
                 surface_tl%Water_Temperature, &  ! TL  Input
                 surface_tl%Salinity         , &  ! TL  Input
                 surface_tl%Wind_Speed       , &  ! TL  Input
                 sfcoptics_tl%Emissivity(i,:), &  ! TL  Output
                 ivar%LF_MWSSEM_Var            )  ! Internal variable input
          sfcoptics_tl%Reflectivity(i,1,i,1) = -sfcoptics_tl%Emissivity(i,1)
          sfcoptics_tl%Reflectivity(i,2,i,2) = -sfcoptics_tl%Emissivity(i,2)
        END DO
      ELSE
        ! Call Fastem1
        DO i = 1, sfcoptics%n_Angles
          sfcoptics_tl%Emissivity(i,2) = (ivar%dEH_dTs(i)*surface_tl%Water_Temperature) + &
                                         (ivar%dEH_dWindSpeed(i)*surface_tl%Wind_Speed)
          sfcoptics_tl%Emissivity(i,1) = (ivar%dEV_dTs(i)*surface_tl%Water_Temperature) + &
                                         (ivar%dEV_dWindSpeed(i)*surface_tl%Wind_Speed)
          sfcoptics_tl%Reflectivity(i,1,i,1) = -sfcoptics_tl%Emissivity(i,1)
          sfcoptics_tl%Reflectivity(i,2,i,2) = -sfcoptics_tl%Emissivity(i,2)
        END DO
      END IF
    END IF

  END FUNCTION compute_mw_water_sfcoptics_tl


!----------------------------------------------------------------------------------
!
! NAME:
!       Compute_MW_Water_SfcOptics_AD
!
! PURPOSE:
!       Function to compute the adjoint surface emissivity and
!       reflectivity at microwave frequencies over a water surface.
!
!       This function is a wrapper for third party code.
!
! CALLING SEQUENCE:
!       Error_Status = Compute_MW_Water_SfcOptics_AD( Surface     , &  ! Input
!                                                     SfcOptics   , &  ! Input
!                                                     SfcOptics_AD, &  ! Input
!                                                     GeometryInfo, &  ! Input
!                                                     SensorIndex , &  ! Input
!                                                     ChannelIndex, &  ! Output
!                                                     Surface_AD  , &  ! Output
!                                                     iVar          )  ! Internal variable input
!
! INPUT ARGUMENTS:
!       Surface:         CRTM_Surface structure containing the surface state
!                        data.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_Surface_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       SfcOptics:       CRTM_SfcOptics structure containing the surface
!                        optical properties required for the radiative
!                        transfer calculation.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_SfcOptics_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
!       SfcOptics_AD:    CRTM_SfcOptics structure containing the adjoint
!                        surface optical properties required for the adjoint
!                        radiative transfer calculation.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_SfcOptics_type)
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN OUT)
!
!       GeometryInfo:    CRTM_GeometryInfo structure containing the
!                        view geometry information.
!                        UNITS:      N/A
!                        TYPE:       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)
!
!       iVar:            Structure containing internal variables required for
!                        subsequent tangent-linear or adjoint model calls.
!                        The contents of this structure are NOT accessible
!                        outside of the CRTM_MW_Water_SfcOptics module.
!                        UNITS:      N/A
!                        TYPE:       iVar_type
!                        DIMENSION:  Scalar
!                        ATTRIBUTES: INTENT(IN)
!
! OUTPUT ARGUMENTS:
!       Surface_AD:      CRTM_Surface structure containing the adjoint
!                        surface state data.
!                        UNITS:      N/A
!                        TYPE:       TYPE(CRTM_Surface_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 SfcOptics_AD argument is IN OUT rather
!       than just OUT. This is necessary because components of this argument
!       may need to be zeroed out upon output.
!
!       Note the INTENT on the output Surface_AD argument is IN OUT rather
!       than just OUT. This is necessary because the argument may be defined
!       upon input. To prevent memory leaks, the IN OUT INTENT is a must.
!
!----------------------------------------------------------------------------------

  FUNCTION compute_mw_water_sfcoptics_ad( &
    SfcOptics   , &  ! Input
    SfcOptics_AD, &  ! Input
    GeometryInfo, &  ! Input
    SensorIndex , &  ! Input
    ChannelIndex, &  ! Input
    Surface_AD  , &  ! Output
    iVar        ) &  ! Internal variable input
  result( err_stat )
    ! Arguments
    TYPE(crtm_sfcoptics_type),    INTENT(IN)     :: sfcoptics
    TYPE(crtm_sfcoptics_type),    INTENT(IN OUT) :: sfcoptics_ad
    TYPE(crtm_geometryinfo_type), INTENT(IN)     :: geometryinfo
    INTEGER,                      INTENT(IN)     :: sensorindex
    INTEGER,                      INTENT(IN)     :: channelindex
    TYPE(crtm_surface_type),      INTENT(IN OUT) :: surface_ad
    TYPE(ivar_type),              INTENT(IN)     :: ivar
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Compute_MW_Water_SfcOptics_AD'
    ! Local variables
    INTEGER :: i, j
    REAL(fp) :: frequency
    REAL(fp) :: source_azimuth_angle, sensor_azimuth_angle
    REAL(fp) :: reflectivity_ad(n_stokes)
    REAL(fp) :: azimuth_angle_ad


    ! Set up
    err_stat = success
    ! ...Retrieve data from structures
    frequency = sc(sensorindex)%Frequency(channelindex)
    CALL crtm_geometryinfo_getvalue( &
           geometryinfo, &
           source_azimuth_angle = source_azimuth_angle, &
           sensor_azimuth_angle = sensor_azimuth_angle  )


    ! Compute the adjoint surface optical parameters
    IF( sfcoptics%Use_New_MWSSEM ) THEN

      ! FastemX model
      azimuth_angle_ad = zero
      DO i = 1, sfcoptics%n_Angles
        DO j = 1, n_stokes
          reflectivity_ad(j) = sfcoptics_ad%Reflectivity(i,j,i,j)
        END DO
        CALL compute_fastemx_ad( &
               mwwaterc                                     , &  ! Input model coefficients
               sfcoptics_ad%Emissivity(i,:)                 , &  ! AD Input
               reflectivity_ad                              , &  ! AD Input
               ivar%FastemX_Var                             , &  ! Internal variable input
               surface_ad%Water_Temperature                 , &  ! AD Output
               surface_ad%Salinity                          , &  ! AD Output
               surface_ad%Wind_Speed                        , &  ! AD Output
               azimuth_angle_ad = azimuth_angle_ad          , &  ! Optional AD Output
               transmittance_ad = sfcoptics_ad%Transmittance  )  ! Optional AD Output
      END DO
      surface_ad%Wind_Direction = surface_ad%Wind_Direction + azimuth_angle_ad

    ELSE

      ! Low frequency model coupled with Fastem1
      IF( frequency < low_f_threshold ) THEN
        ! Call the low frequency model
        DO i = 1, sfcoptics%n_Angles
          sfcoptics_ad%Emissivity(i,1) = sfcoptics_ad%Emissivity(i,1)-sfcoptics_ad%Reflectivity(i,1,i,1)
          sfcoptics_ad%Emissivity(i,2) = sfcoptics_ad%Emissivity(i,2)-sfcoptics_ad%Reflectivity(i,2,i,2)
          CALL lowfrequency_mwssem_ad( &
                 sfcoptics_ad%Emissivity(i,:), &  ! AD  Input
                 surface_ad%Water_Temperature, &  ! AD  Output
                 surface_ad%Salinity         , &  ! AD  Output
                 surface_ad%Wind_Speed       , &  ! AD  Output
                 ivar%LF_MWSSEM_Var            )  ! Internal variable input
        END DO
      ELSE
        ! Call Fastem1
        DO i = sfcoptics%n_Angles, 1, -1
          DO j = 1, 2
            sfcoptics_ad%Emissivity(i,j) = sfcoptics_ad%Emissivity(i,j) - &
                                           sfcoptics_ad%Reflectivity(i,j,i,j)
            sfcoptics_ad%Reflectivity(i,j,i,j) = zero
          END DO
          ! Vertical polarisation component
          surface_ad%Water_Temperature  = surface_ad%Water_Temperature + &
                                          (ivar%dEV_dTs(i)*sfcoptics_ad%Emissivity(i,1))
          surface_ad%Wind_Speed         = surface_ad%Wind_Speed + &
                                          (ivar%dEV_dWindSpeed(i)*sfcoptics_ad%Emissivity(i,1))
          sfcoptics_ad%Emissivity(i,1)  = zero
          ! Horizontal polarization component
          surface_ad%Water_Temperature  = surface_ad%Water_Temperature + &
                                          (ivar%dEH_dTs(i)*sfcoptics_ad%Emissivity(i,2))
          surface_ad%Wind_Speed         = surface_ad%Wind_Speed + &
                                          (ivar%dEH_dWindSpeed(i)*sfcoptics_ad%Emissivity(i,2))
          sfcoptics_ad%Emissivity(i,2)  = zero
        END DO
      END IF
    END IF

    sfcoptics_ad%Reflectivity = zero

  END FUNCTION compute_mw_water_sfcoptics_ad

END MODULE crtm_mw_water_sfcoptics