Small_Scale_Correction_Module.f90

Go to the documentation of this file.

!
! Small_Scale_Correction_Module
!
! Module containing the small-scale correction procedures for the 
! CRTM implementations of FASTEM4 and FASTEM5
!
! Equation (A4) of
!
!   Liu, Q. et al. (2011) An Improved Fast Microwave Water
!     Emissivity Model, TGRSS, 49, pp1238-1250
!
! describes the fitting of the small-scale correction formulation
! given in equation (17a,b) of
!
!   Liu, Q. et al. (1998) Monte Carlo simulations of the microwave
!     emissivity of the sea surface, JGR, 103, pp24983-24989
!
! and originally in equation (30) of
!
!   Guissard,A. and P.Sobieski (1987) An approximate model
!     for the microwave brightness temperature of the sea,
!     Int.J.Rem.Sens., 8, pp1607-1627.
!
!
! CREATION HISTORY:
!       Written by:     Original FASTEM authors
!
!       Refactored by:  Paul van Delst, November 2011
!                       paul.vandelst@noaa.gov
!

MODULE small_scale_correction_module

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE type_kinds     , ONLY: fp
  USE fitcoeff_define, ONLY: fitcoeff_1d_type
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  ! Data types
  PUBLIC :: ivar_type
  ! Science routines
  PUBLIC :: small_scale_correction
  PUBLIC :: small_scale_correction_tl
  PUBLIC :: small_scale_correction_ad


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

  ! Literal constants
  REAL(fp), PARAMETER :: zero = 0.0_fp
  REAL(fp), PARAMETER :: one  = 1.0_fp
  REAL(fp), PARAMETER :: two  = 2.0_fp
  ! Minimum and maximum frequency
  REAL(fp), PARAMETER :: min_frequency = 1.4_fp
  REAL(fp), PARAMETER :: max_frequency = 200.0_fp
  ! Minimum and maximum wind speed
  REAL(fp), PARAMETER :: min_wind_speed = 0.3_fp
  REAL(fp), PARAMETER :: max_wind_speed = 35.0_fp


  ! --------------------------------------
  ! Structure definition to hold internal
  ! variables across FWD, TL, and AD calls
  ! --------------------------------------
  TYPE :: ivar_type
    PRIVATE
    ! Direct inputs
    REAL(fp) :: wind_speed = zero
    REAL(fp) :: frequency  = zero
    ! Flag to indicate if wind spped outside limits
    LOGICAL  :: wind_speed_limited = .false.
    ! Intermediate variables
    REAL(fp) :: f2     = zero
    REAL(fp) :: y      = zero
    REAL(fp) :: cos2_z = zero
    ! Final result (since equation is an exponential)
    REAL(fp) :: correction = zero
  END TYPE ivar_type


CONTAINS


  ! =============================================================
  ! Procedures to compute the reflectivity small scale correction
  ! =============================================================
  ! Forward model
  SUBROUTINE small_scale_correction( &
    SSCCoeff  , &  ! Input
    Frequency , &  ! Input
    cos_Z     , &  ! Input
    Wind_Speed, &  ! Input
    Correction, &  ! Output
    iVar        )  ! Internal variable output
    ! Arguments
    TYPE(fitcoeff_1d_type), INTENT(IN)     :: ssccoeff
    REAL(fp),               INTENT(IN)     :: frequency
    REAL(fp),               INTENT(IN)     :: cos_z
    REAL(fp),               INTENT(IN)     :: wind_speed
    REAL(fp),               INTENT(OUT)    :: correction
    TYPE(ivar_type),        INTENT(IN OUT) :: ivar
    ! Local variables
    REAL(fp) :: w2
    
    ! Check input
    ivar%frequency = frequency
    IF ( ivar%frequency < min_frequency ) ivar%frequency = min_frequency
    IF ( ivar%frequency > max_frequency ) ivar%frequency = max_frequency
    ivar%wind_speed         = wind_speed
    ivar%wind_speed_limited = .false.
    IF ( ivar%wind_speed < min_wind_speed ) THEN
      ivar%wind_speed         = min_wind_speed
      ivar%wind_speed_limited = .true.
    END IF
    IF ( ivar%wind_speed > max_wind_speed ) THEN
      ivar%wind_speed         = max_wind_speed
      ivar%wind_speed_limited = .true.
    END IF

    ! Compute correction
    ivar%f2 = ivar%frequency**2
    w2      = ivar%wind_speed**2
    ! ...Intermediate term regression equation   
    ivar%y = &
      (ssccoeff%C(1) * ivar%wind_speed    * ivar%frequency) + &
      (ssccoeff%C(2) * ivar%wind_speed    * ivar%f2       ) + &
      (ssccoeff%C(3) * w2                 * ivar%frequency) + &
      (ssccoeff%C(4) * w2                 * ivar%f2       ) + &
      (ssccoeff%C(5) * w2                 / ivar%frequency) + &
      (ssccoeff%C(6) * w2                 / ivar%f2       ) + &
      (ssccoeff%C(7) * ivar%wind_speed                    ) + &
      (ssccoeff%C(8) * w2                                 )
    ! ... The correction
    ivar%cos2_z     = cos_z**2  
    ivar%correction = exp(-ivar%y*ivar%cos2_z)
    correction = ivar%correction

  END SUBROUTINE small_scale_correction


  ! Tangent-linear model
  SUBROUTINE small_scale_correction_tl( &
    SSCCoeff     , &  ! Input
    Wind_Speed_TL, &  ! TL input
    Correction_TL, &  ! TL output
    iVar           )  ! Internal variable input
    ! Arguments
    TYPE(fitcoeff_1d_type), INTENT(IN)  :: ssccoeff
    REAL(fp),               INTENT(IN)  :: wind_speed_tl
    REAL(fp),               INTENT(OUT) :: correction_tl
    TYPE(ivar_type),        INTENT(IN)  :: ivar
    ! Local variables
    REAL(fp) :: y_tl
    REAL(fp) :: two_w
    
    ! Check input
    IF ( ivar%wind_speed_limited ) THEN
      correction_tl = zero
      RETURN
    END IF

    ! Compute tangent-linear intermediate term
    two_w = two * ivar%wind_speed
    y_tl = &
      ( (ssccoeff%C(1) * ivar%frequency        ) + &
        (ssccoeff%C(2) * ivar%f2               ) + &
        (ssccoeff%C(3) * two_w * ivar%frequency) + &
        (ssccoeff%C(4) * two_w * ivar%f2       ) + &
        (ssccoeff%C(5) * two_w / ivar%frequency) + &
        (ssccoeff%C(6) * two_w / ivar%f2       ) + &
         ssccoeff%C(7)                           + &
        (ssccoeff%C(8) * two_w                 )   ) * wind_speed_tl

    ! Compute the tangent-linear correction
    correction_tl = -ivar%cos2_z * ivar%correction * y_tl

  END SUBROUTINE small_scale_correction_tl
  

  ! Adjoint model
  SUBROUTINE small_scale_correction_ad( &
    SSCCoeff     , &  ! Input
    Correction_AD, &  ! AD input
    Wind_Speed_AD, &  ! AD output
    iVar           )  ! Internal variable input
    TYPE(fitcoeff_1d_type), INTENT(IN)     :: ssccoeff
    REAL(fp),               INTENT(IN OUT) :: correction_ad
    REAL(fp),               INTENT(IN OUT) :: wind_speed_ad
    TYPE(ivar_type),        INTENT(IN)     :: ivar
    ! Local variables
    REAL(fp) :: y_ad
    REAL(fp) :: two_w

    ! Check input
    IF ( ivar%wind_speed_limited ) THEN
      correction_ad = zero
      RETURN
    END IF
        
    ! Adjoint of correction
    y_ad = -ivar%cos2_z * ivar%correction * correction_ad
    correction_ad = zero
    
    ! Adjoint of intermediate term
    two_w = two * ivar%wind_speed
    wind_speed_ad = wind_speed_ad + & 
                    ( (ssccoeff%C(1) * ivar%frequency        ) + &
                      (ssccoeff%C(2) * ivar%f2               ) + &
                      (ssccoeff%C(3) * two_w * ivar%frequency) + &
                      (ssccoeff%C(4) * two_w * ivar%f2       ) + &
                      (ssccoeff%C(5) * two_w / ivar%frequency) + &
                      (ssccoeff%C(6) * two_w / ivar%f2       ) + &
                       ssccoeff%C(7)                           + &
                      (ssccoeff%C(8) * two_w                 )   ) * y_ad

  END SUBROUTINE small_scale_correction_ad

END MODULE small_scale_correction_module