<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! Helper module containing the azimuth emissivity routines for the
! CRTM implementation of FASTEM4 and FASTEM5
!
!
! CREATION HISTORY:
! Written by: Original FASTEM1/2/3 authors
!
! Modified by: Quanhua Liu, Quanhua.Liu@noaa.gov
! Stephen English, Stephen.English@metoffice.gov.uk
! July, 2009
!
! Refactored by: Paul van Delst, December 2011
! paul.vandelst@noaa.gov
!
<A NAME='AZIMUTH_EMISSIVITY_MODULE'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#AZIMUTH_EMISSIVITY_MODULE' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE Azimuth_Emissivity_Module 1
! -----------------
! Environment setup
! -----------------
! Module use
USE Type_Kinds
, ONLY: fp
USE FitCoeff_Define, ONLY: FitCoeff_3D_type
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
PRIVATE
! Data types
PUBLIC :: iVar_type
! Science routines
PUBLIC :: Azimuth_Emissivity
PUBLIC :: Azimuth_Emissivity_TL
PUBLIC :: Azimuth_Emissivity_AD
! -----------------
! Module parameters
! -----------------
CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
'$Id: Azimuth_Emissivity_Module.f90 29405 2013-06-20 20:19:52Z paul.vandelst@noaa.gov $'
REAL(fp), PARAMETER :: ZERO = 0.0_fp
REAL(fp), PARAMETER :: ONE = 1.0_fp
REAL(fp), PARAMETER :: TWO = 2.0_fp
REAL(fp), PARAMETER :: THREE = 3.0_fp
REAL(fp), PARAMETER :: PI = 3.141592653589793238462643383279_fp
REAL(fp), PARAMETER :: DEGREES_TO_RADIANS = PI / 180.0_fp
! Dimensions
! ...Number of component predictors for harmonic coefficients
INTEGER, PARAMETER :: N_PREDICTORS = 10
! ...Number of Stokes parameters
INTEGER, PARAMETER :: N_STOKES = 4
! ...The number of harmonics considered in the trignometric parameterisation
INTEGER, PARAMETER :: N_HARMONICS = 3
! --------------------------------------
! 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
! Derived inputs
REAL(fp) :: sec_z = ZERO
! Cosine and sine of the harmonic angle, m*phi
REAL(fp) :: cos_angle(N_HARMONICS) = ZERO
REAL(fp) :: sin_angle(N_HARMONICS) = ZERO
! Intermediate variables
REAL(fp) :: trig_coeff(N_STOKES, N_HARMONICS) = ZERO
END TYPE iVar_type
CONTAINS
! ===========================================================
! Compute emissivity as a function of relative azimuth angle.
! ===========================================================
! Forward model
<A NAME='AZIMUTH_EMISSIVITY'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#AZIMUTH_EMISSIVITY' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Azimuth_Emissivity( & 1,2
AZCoeff , & ! Input
Wind_Speed , & ! Input
Azimuth_Angle, & ! Input
Frequency , & ! Input
cos_z , & ! Input
e_Azimuth , & ! Output
iVar ) ! Internal variable output
! Arguments
TYPE(FitCoeff_3D_type), INTENT(IN) :: AZCoeff
REAL(fp) , INTENT(IN) :: Wind_Speed
REAL(fp) , INTENT(IN) :: Azimuth_Angle
REAL(fp) , INTENT(IN) :: Frequency
REAL(fp) , INTENT(IN) :: cos_z
REAL(fp) , INTENT(OUT) :: e_Azimuth(:)
TYPE(iVar_type) , INTENT(IN OUT) :: iVar
! Local variables
INTEGER :: i, m
REAL(fp) :: phi, angle
REAL(fp) :: predictor(N_PREDICTORS)
! Initialise output
e_Azimuth = ZERO
! Save inputs for TL and AD calls
iVar%wind_speed = Wind_Speed
iVar%frequency = Frequency
iVar%sec_z = ONE/cos_z
! Convert angle
phi = Azimuth_Angle * DEGREES_TO_RADIANS
! Compute the azimuth emissivity component predictors
CALL Compute_Predictors( Wind_Speed, Frequency, iVar%sec_z, Predictor )
! Compute the azimuth emissivity vector
Harmonic_Loop: DO m = 1, N_HARMONICS
! Compute the angles
angle = REAL(m,fp) * phi
iVar%cos_angle(m) = COS(angle)
iVar%sin_angle(m) = SIN(angle)
! Compute the coefficients
DO i = 1, N_STOKES
CALL Compute_Coefficient( &
AZCoeff%C(:,i,m), &
Predictor, &
iVar%trig_coeff(i,m) )
END DO
! Compute the emissivities
e_Azimuth(1) = e_Azimuth(1) + iVar%trig_coeff(1,m)*iVar%cos_angle(m) ! Vertical
e_Azimuth(2) = e_Azimuth(2) + iVar%trig_coeff(2,m)*iVar%cos_angle(m) ! Horizontal
e_Azimuth(3) = e_Azimuth(3) + iVar%trig_coeff(3,m)*iVar%sin_angle(m) ! +/- 45deg.
e_Azimuth(4) = e_Azimuth(4) + iVar%trig_coeff(4,m)*iVar%sin_angle(m) ! Circular
END DO Harmonic_Loop
! Apply frequency correction
e_Azimuth = e_Azimuth * Azimuth_Freq_Correction(Frequency)
END SUBROUTINE Azimuth_Emissivity
! Tangent-linear model
<A NAME='AZIMUTH_EMISSIVITY_TL'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#AZIMUTH_EMISSIVITY_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Azimuth_Emissivity_TL( & 1,2
AZCoeff , & ! Input
Wind_Speed_TL , & ! Input
Azimuth_Angle_TL, & ! Input
e_Azimuth_TL , & ! Output
iVar ) ! Internal variable input
! Arguments
TYPE(FitCoeff_3D_type), INTENT(IN) :: AZCoeff
REAL(fp) , INTENT(IN) :: Wind_Speed_TL
REAL(fp) , INTENT(IN) :: Azimuth_Angle_TL
REAL(fp) , INTENT(OUT) :: e_Azimuth_TL(:)
TYPE(iVar_type) , INTENT(IN) :: iVar
! Local variables
INTEGER :: i, m
REAL(fp) :: phi_TL, angle_TL
REAL(fp) :: predictor_TL(N_PREDICTORS)
REAL(fp) :: trig_coeff_TL(N_STOKES)
! Initialise output
e_Azimuth_TL = ZERO
! Compute angle perturbation in radians
phi_TL = Azimuth_Angle_TL * DEGREES_TO_RADIANS
! Compute the azimuth emissivity component tangent-linear predictors
CALL Compute_Predictors_TL( iVar%wind_speed, iVar%frequency, iVar%sec_z, Wind_Speed_TL, predictor_TL )
! Compute the tangent-linear azimuth emissivity vector
Harmonic_Loop: DO m = 1, N_HARMONICS
! Compute the angles
angle_TL = REAL(m,fp) * phi_TL
! Compute the coefficients
DO i = 1, N_STOKES
CALL Compute_Coefficient_TL( &
AZCoeff%C(:,i,m), &
predictor_TL, &
trig_coeff_TL(i) )
END DO
! Compute the tangent-linear emissivities
! ...Vertical polarisation
e_Azimuth_TL(1) = e_Azimuth_TL(1) + iVar%cos_angle(m)*trig_coeff_TL(1) - &
iVar%trig_coeff(1,m)*iVar%sin_angle(m)*angle_TL
! ...Horizontal polarisation
e_Azimuth_TL(2) = e_Azimuth_TL(2) + iVar%cos_angle(m)*trig_coeff_TL(2) - &
iVar%trig_coeff(2,m)*iVar%sin_angle(m)*angle_TL
! ...+/- 45deg. polarisation
e_Azimuth_TL(3) = e_Azimuth_TL(3) + iVar%sin_angle(m)*trig_coeff_TL(3) + &
iVar%trig_coeff(3,m)*iVar%cos_angle(m)*angle_TL
! ...Circular polarisation
e_Azimuth_TL(4) = e_Azimuth_TL(4) + iVar%sin_angle(m)*trig_coeff_TL(4) + &
iVar%trig_coeff(4,m)*iVar%cos_angle(m)*angle_TL
END DO Harmonic_Loop
! Apply tangent-linear frequency correction
e_Azimuth_TL = e_Azimuth_TL * Azimuth_Freq_Correction(iVar%frequency)
END SUBROUTINE Azimuth_Emissivity_TL
! Adjoint model
<A NAME='AZIMUTH_EMISSIVITY_AD'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#AZIMUTH_EMISSIVITY_AD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Azimuth_Emissivity_AD( & 1,2
AZCoeff , & ! Input
e_Azimuth_AD , & ! AD Input
Wind_Speed_AD , & ! AD Output
Azimuth_Angle_AD, & ! AD Output
iVar ) ! Internal variable input
! Arguments
TYPE(FitCoeff_3D_type), INTENT(IN) :: AZCoeff
REAL(fp) , INTENT(IN OUT) :: e_Azimuth_AD(:)
REAL(fp) , INTENT(IN OUT) :: Wind_Speed_AD
REAL(fp) , INTENT(IN OUT) :: Azimuth_Angle_AD
TYPE(iVar_type) , INTENT(IN) :: iVar
! Local variables
INTEGER :: i, m
REAL(fp) :: phi_AD, angle_AD
REAL(fp) :: predictor_AD(N_PREDICTORS)
REAL(fp) :: trig_coeff_AD(N_STOKES)
! Initialise local adjoints
phi_AD = ZERO
predictor_AD = ZERO
! Adjoint of frequency correction
e_Azimuth_AD = e_Azimuth_AD * Azimuth_Freq_Correction(iVar%frequency)
! Compute the azimuth emissivity vector adjoint
Harmonic_Loop: DO m = 1, N_HARMONICS
! Compute the adjoint of the emissivities
! ...Circular polarisation
angle_AD = iVar%trig_coeff(4,m)*iVar%cos_angle(m)*e_Azimuth_AD(4)
trig_coeff_AD(4) = iVar%sin_angle(m)*e_Azimuth_AD(4)
! ...+/- 45deg. polarisation
angle_AD = angle_AD + iVar%trig_coeff(3,m)*iVar%cos_angle(m)*e_Azimuth_AD(3)
trig_coeff_AD(3) = iVar%sin_angle(m)*e_Azimuth_AD(3)
! ...Horizontal polarisation
angle_AD = angle_AD - iVar%trig_coeff(2,m)*iVar%sin_angle(m)*e_Azimuth_AD(2)
trig_coeff_AD(2) = iVar%cos_angle(m)*e_Azimuth_AD(2)
! ...Vertical polarisation
angle_AD = angle_AD - iVar%trig_coeff(1,m)*iVar%sin_angle(m)*e_Azimuth_AD(1)
trig_coeff_AD(1) = iVar%cos_angle(m)*e_Azimuth_AD(1)
! Compute the adjoint of the coefficients
DO i = N_STOKES, 1, -1
CALL Compute_Coefficient_AD( &
AZCoeff%C(:,i,m), &
trig_coeff_AD(i), &
predictor_AD )
END DO
! Compute the angle adjoint
phi_AD = phi_AD + REAL(m,fp)*angle_AD
END DO Harmonic_Loop
! Compute the azimuth emissivity component predictor adjoint
CALL Compute_Predictors_AD( iVar%wind_speed, iVar%frequency, iVar%sec_z, predictor_AD, Wind_Speed_AD )
! Adjoint of the angle perturbation in radians
Azimuth_Angle_AD = Azimuth_Angle_AD + phi_AD*DEGREES_TO_RADIANS
END SUBROUTINE Azimuth_Emissivity_AD
!################################################################################
!################################################################################
!## ##
!## ## PRIVATE MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
! =============================================
! Compute predictors for the azimuth components
! =============================================
! Forward model
<A NAME='COMPUTE_PREDICTORS'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#COMPUTE_PREDICTORS' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Compute_Predictors( & 1
Wind_Speed, & ! Input
Frequency , & ! Input
sec_z , & ! Input
Predictor ) ! Output
! Arguments
REAL(fp), INTENT(IN) :: Wind_Speed
REAL(fp), INTENT(IN) :: Frequency
REAL(fp), INTENT(IN) :: sec_z
REAL(fp), INTENT(OUT) :: Predictor(N_PREDICTORS)
! Compute the predictors.
Predictor( 1) = ONE
Predictor( 2) = Frequency
Predictor( 3) = sec_z
Predictor( 4) = sec_z * Frequency
Predictor( 5) = Wind_Speed
Predictor( 6) = Wind_Speed * Frequency
Predictor( 7) = Wind_Speed**2
Predictor( 8) = Frequency * Wind_Speed**2
Predictor( 9) = Wind_Speed * sec_z
Predictor(10) = Wind_Speed * sec_z * Frequency
END SUBROUTINE Compute_Predictors
! Tangent-linear model
<A NAME='COMPUTE_PREDICTORS_TL'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#COMPUTE_PREDICTORS_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Compute_Predictors_TL( & 1
Wind_Speed , & ! FWD Input
Frequency , & ! FWD Input
sec_z , & ! FWD Input
Wind_Speed_TL, & ! TL Input
Predictor_TL ) ! TL Output
! Arguments
REAL(fp), INTENT(IN) :: Wind_Speed
REAL(fp), INTENT(IN) :: Frequency
REAL(fp), INTENT(IN) :: sec_z
REAL(fp), INTENT(IN) :: Wind_Speed_TL
REAL(fp), INTENT(OUT) :: Predictor_TL(N_PREDICTORS)
! Compute the tangent-linear predictors.
Predictor_TL( 1) = ZERO
Predictor_TL( 2) = ZERO
Predictor_TL( 3) = ZERO
Predictor_TL( 4) = ZERO
Predictor_TL( 5) = Wind_Speed_TL
Predictor_TL( 6) = Frequency * Wind_Speed_TL
Predictor_TL( 7) = TWO * Wind_Speed * Wind_Speed_TL
Predictor_TL( 8) = TWO * Frequency * Wind_Speed * Wind_Speed_TL
Predictor_TL( 9) = sec_z * Wind_Speed_TL
Predictor_TL(10) = sec_z * Frequency * Wind_Speed_TL
END SUBROUTINE Compute_Predictors_TL
! Adjoint model
<A NAME='COMPUTE_PREDICTORS_AD'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#COMPUTE_PREDICTORS_AD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Compute_Predictors_AD( & 1
Wind_Speed , & ! FWD Input
Frequency , & ! FWD Input
sec_z , & ! FWD Input
Predictor_AD , & ! AD Input
Wind_Speed_AD ) ! AD Output
! Arguments
REAL(fp), INTENT(IN) :: Wind_Speed
REAL(fp), INTENT(IN) :: Frequency
REAL(fp), INTENT(IN) :: sec_z
REAL(fp), INTENT(IN OUT) :: Predictor_AD(N_PREDICTORS)
REAL(fp), INTENT(IN OUT) :: Wind_Speed_AD
! Compute the predictor adjoints
Wind_Speed_AD = Wind_Speed_AD + &
sec_z * Frequency * Predictor_AD(10) + &
sec_z * Predictor_AD( 9) + &
TWO * Frequency * Wind_Speed * Predictor_AD( 8) + &
TWO * Wind_Speed * Predictor_AD( 7) + &
Frequency * Predictor_AD( 6) + &
Predictor_AD( 5)
Predictor_AD = ZERO
END SUBROUTINE Compute_Predictors_AD
! ==============================================================
! Compute the component coefficient from the regression equation
! ==============================================================
! Forward model
<A NAME='COMPUTE_COEFFICIENT'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#COMPUTE_COEFFICIENT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Compute_Coefficient( & 1
c , & ! Input
X , & ! Input
Coefficient ) ! Output
! Arguments
REAL(fp), INTENT(IN) :: c(:) ! regression coefficient
REAL(fp), INTENT(IN) :: X(:) ! predictor
REAL(fp), INTENT(OUT) :: Coefficient
! Local variables
INTEGER :: i
! Compute component coefficient
Coefficient = ZERO
DO i = 1, N_PREDICTORS
Coefficient = Coefficient + c(i)*X(i)
END DO
END SUBROUTINE Compute_Coefficient
! Tangent-linear model
<A NAME='COMPUTE_COEFFICIENT_TL'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#COMPUTE_COEFFICIENT_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Compute_Coefficient_TL( & 1
c , & ! Input
X_TL , & ! Input
Coefficient_TL ) ! Output
! Arguments
REAL(fp), INTENT(IN) :: c(:) ! regression coefficient
REAL(fp), INTENT(IN) :: X_TL(:) ! predictor
REAL(fp), INTENT(OUT) :: Coefficient_TL
! Local variables
INTEGER :: i
! Compute tangent-linear component coefficient
Coefficient_TL = ZERO
DO i = 1, N_PREDICTORS
Coefficient_TL = Coefficient_TL + c(i)*X_TL(i)
END DO
END SUBROUTINE Compute_Coefficient_TL
! Adjoint model
<A NAME='COMPUTE_COEFFICIENT_AD'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#COMPUTE_COEFFICIENT_AD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Compute_Coefficient_AD( & 1
c , & ! Input
Coefficient_AD, & ! Input
X_AD ) ! Output
! Arguments
REAL(fp), INTENT(IN) :: c(:) ! regression coefficient
REAL(fp), INTENT(IN OUT) :: Coefficient_AD
REAL(fp), INTENT(IN OUT) :: X_AD(:) ! predictor
! Local variables
INTEGER :: i
! Compute adjoint of the component coefficient
DO i = 1, N_PREDICTORS
X_AD(i) = X_AD(i) + c(i)*Coefficient_AD
END DO
Coefficient_AD = ZERO
END SUBROUTINE Compute_Coefficient_AD
<A NAME='AZIMUTH_FREQ_CORRECTION'><A href='../../html_code/crtm/Azimuth_Emissivity_Module.f90.html#AZIMUTH_FREQ_CORRECTION' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
PURE FUNCTION Azimuth_Freq_Correction( Frequency ) RESULT( Fre_C )
IMPLICIT NONE
REAL( fp ), INTENT(IN) :: Frequency
REAL( fp ) :: Fre_C
INTEGER :: i
! Data for the frequency correction
REAL(fp), PARAMETER :: x(9) = (/ 0.0_fp, 1.4_fp, 6.8_fp, 10.7_fp, 19.35_fp, &
37._fp, 89._fp, 150._fp, 200._fp/)
REAL(fp), PARAMETER :: y(9) = (/ 0.0_fp, 0.1_fp, 0.6_fp, 0.9_fp, 1._fp, &
1.0_fp, 0.4_fp, 0.2_fp, 0.0_fp/)
!
IF( Frequency <= ZERO .or. Frequency >= 200.0_fp ) THEN
Fre_C = ZERO
RETURN
ELSE
DO i = 1, 8
IF( Frequency >= x(i) .and. Frequency <= x(i+1) ) THEN
Fre_C = y(i) + (y(i+1)-y(i))/(x(i+1)-x(i))*(Frequency-x(i))
RETURN
END IF
END DO
END IF
Fre_C = ZERO
END FUNCTION Azimuth_Freq_Correction
END MODULE Azimuth_Emissivity_Module