! ! ODZeeman_Predictor ! ! Module containing routines to compute the predictors for calculations ! gaseous absorption affected by Zeeman spilitting in ! the Optical Depth Pressure Space (ODPS). ! ! ! CREATION HISTORY: ! Written by: Yong Han, JCSDA, NOAA/NESDIS 20-Sep-2008 ! MODULE ODZeeman_Predictor ! Environment setup ! ----------------- ! Module use USE Type_Kinds, ONLY: fp USE Message_Handler, ONLY: SUCCESS, FAILURE, Display_Message USE ODPS_Predictor_Define, ONLY: ODPS_Predictor_type USE ODPS_Define, ONLY: ODPS_type ! Disable implicit typing IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! Everything private by default PRIVATE ! Public routines PUBLIC :: Compute_Predictors_zssmis PUBLIC :: Compute_Predictors_zssmis_TL PUBLIC :: Compute_Predictors_zssmis_AD PUBLIC :: Compute_Predictors_zamsua PUBLIC :: Compute_Predictors_zamsua_TL PUBLIC :: Compute_Predictors_zamsua_AD ! Public parameters PUBLIC :: N_ZCOMPONENTS PUBLIC :: N_ZABSORBERS PUBLIC :: MAX_N_PREDICTORS_ZSSMIS PUBLIC :: MAX_N_PREDICTORS_ZAMSUA PUBLIC :: ZSSMIS_ChannelMap PUBLIC :: ZAMSUA_ChannelMap PUBLIC :: ODPS_gINDEX_ZSSMIS PUBLIC :: ODPS_gINDEX_ZAMSUA ! ---------- ! Parameters ! ---------- REAL(fp), PARAMETER :: ZERO = 0.0_fp, ONE = 1.0_fp, TWO = 2.0_fp INTEGER, PARAMETER :: N_ZCOMPONENTS = 1 ! set this variable to 1 although it should be 1 to consistant with the ODPS structure (for ! Zeeman applications only O2 need to be considered, which will be include as a fixed gas, decribed ! by pressure and temperature. INTEGER, PARAMETER :: N_ZABSORBERS = 1 !---------------------------------------------------------------- ! ZSSMIS parameters (SSMIS channels 19 - 22) !---------------------------------------------------------------- INTEGER, PARAMETER :: ODPS_gINDEX_ZSSMIS = 4 ! ODPS group index INTEGER, PARAMETER :: MAX_N_PREDICTORS_ZSSMIS = 18 ! Global to ZSSMIS channel index mapping INTEGER, PARAMETER :: N_CHANNELS_SSMIS = 24 INTEGER, PARAMETER :: ZSSMIS_ChannelMap(N_CHANNELS_SSMIS) = (/& 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, & 3, 4, 0, 0 /) !---------------------------------------------------------------- ! ZAMSUA parameters (AMSUA channel 14) !---------------------------------------------------------------- INTEGER, PARAMETER :: MAX_N_PREDICTORS_ZAMSUA = 7 INTEGER, PARAMETER :: ODPS_gINDEX_ZAMSUA = 5 ! ODPS group index ! Global to ZAMSUA channel index mapping INTEGER, PARAMETER :: N_CHANNELS_AMSUA = 15 INTEGER, PARAMETER :: ZAMSUA_ChannelMap(N_CHANNELS_AMSUA) = (/& 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 0, 1, 0/) CONTAINS !------------------------------------------------------------------------------ ! ! NAME: ! Compute_Predictors_zssmis ! ! PURPOSE: ! Subroutine to compute predictors for the ZSSMIS sensor (a virtual sensor ! created for SSMIS Zeeman channels 19, 20, 21 and 22 ! ! CALLING SEQUENCE: ! CALL Compute_Predictors_zssmis(Temperature, & ! Be, & ! CosBK, & ! Doppler_Shift, & ! Secang, & ! Predictor ) ! ! INPUT ARGUMENTS: ! ! Temperature: Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Be : Earth magnetic filed strength ! UNITS: Guass (range 0.2 - 0.7) ! TYPE: REAL(fp) ! DIMENSION: scalar ! ATTRIBUTES: INTENT(IN) ! ! CosBK : Cosine of the angle between the Earth magnetic ! field and the electromagnetic wave propagation ! direction ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Doppler_Shift : Doppler shift due Earth ratation, positive when ! the emitter moves towards the sensor ! UNITS: KHz ! TYPE: REAL(fp) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Secang : Secant of the zenith angle profile ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! OUTPUT ARGUMENTS: ! Predictor: Predictor structure ! UNITS: N/A ! TYPE: TYPE(ODPS_Predictor_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! !------------------------------------------------------------------------------ SUBROUTINE Compute_Predictors_zssmis(Temperature, & Be, & CosBK, & Doppler_Shift, & Secang, & Predictor ) REAL(fp), INTENT( IN ) :: Temperature(:) REAL(fp), INTENT( IN ) :: Be REAL(fp), INTENT( IN ) :: CosBK REAL(fp), INTENT( IN ) :: Doppler_Shift REAL(fp), INTENT( IN ) :: Secang(:) TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor ! LOCAL REAL(fp) :: Be2, Be3, OneOverBe, OneOverBe2, CosBK2, OneOverT INTEGER :: k Be2 = Be * Be Be3 = Be2 * Be OneOverBe = ONE / Be OneOverBe2 = OneOverBe * OneOverBe CosBK2 = CosBK * CosBK DO k = 1, Predictor%n_Layers ! Predictors associated Temperature OneOverT = 300.0_fp / Temperature(k) Predictor%X(k, 1, 1) = OneOverT ! 1/T Predictor%X(k, 2, 1) = OneOverT * CosBK2 ! COS(BK_ang)**2 / T Predictor%X(k, 3, 1) = OneOverT / Be ! 1 / (T*Be) Predictor%X(k, 4, 1) = OneOverT * CosBK / Be ! COS(BK_ang) / (T*Be) Predictor%X(k, 5, 1) = OneOverT * CosBK / Be2 ! COS(BK_ang) / (T*Be**2) END DO ! Constant predictor Predictor%X(:, 6, 1) = ONE ! 1 - constant term Predictor%X(:, 7, 1) = CosBK ! COS(BK_ang) Predictor%X(:, 8, 1) = CosBK2 ! COS(BK_ang)**2 Predictor%X(:, 9, 1) = OneOverBe ! 1 / Be Predictor%X(:, 10, 1) = OneOverBe2 ! 1 / Be**2 Predictor%X(:, 11, 1) = OneOverBe2 * OneOverBe ! 1 / Be^3 Predictor%X(:, 12, 1) = CosBK * Be2 ! COS(BK_ang) * Be**2 Predictor%X(:, 13, 1) = CosBK2 * Be2 ! (COS(BK_ang) * Be)**2 Predictor%X(:, 14, 1) = CosBK * Be3 ! COS(BK_ang) * Be**3 Predictor%X(:, 15, 1) = Be ! Be Predictor%X(:, 16, 1) = Be3 ! Be**3 Predictor%X(:, 17, 1) = CosBK * Be ! COS(BK_ang)*Be Predictor%X(:, 18, 1) = CosBK2 * Be ! COS(BK_ang)**2*Be Predictor%n_CP(1) = MAX_N_PREDICTORS_ZSSMIS ! pass Doppler shift and Secant angle to Predicotr structre Predictor%u = Doppler_Shift Predictor%Secant_Zenith = Secang END SUBROUTINE Compute_Predictors_zssmis !------------------------------------------------------------------------------ ! ! NAME: ! Compute_Predictors_zssmis_TL ! ! PURPOSE: ! Subroutine to compute TL predictors for the ZSSMIS sensor (a virtual sensor ! created for SSMIS Zeeman channels 19, 20, 21 and 22) ! ! CALLING SEQUENCE: ! ! CALL Compute_Predictors_zssmis_TL(Temperature, & ! Be, & ! CosBK, & ! Temperature_TL,& ! Predictor_TL ) ! INPUT ARGUMENTS: ! ! Temperature: Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Be : Earth magnetic filed strength ! UNITS: Guass (range 0.2 - 0.7) ! TYPE: REAL(fp) ! DIMENSION: scalar ! ATTRIBUTES: INTENT(IN) ! ! CosBK : Cosine of the angle between the Earth magnetic ! field and the electromagnetic wave propagation ! direction ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Temperature_TL: TL Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! OUTPUT ARGUMENTS: ! Predictor_TL: TL Predictor structure ! UNITS: N/A ! TYPE: TYPE(ODPS_Predictor_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! !------------------------------------------------------------------------------ SUBROUTINE Compute_Predictors_zssmis_TL(Temperature, & Be, & CosBK, & Temperature_TL,& Predictor_TL ) REAL(fp), INTENT( IN ) :: Temperature(:) REAL(fp), INTENT( IN ) :: Be REAL(fp), INTENT( IN ) :: CosBK REAL(fp), INTENT( IN ) :: Temperature_TL(:) TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor_TL ! LOCAL REAL(fp) :: Be2, CosBK2, OneOverT, OneOverT_TL INTEGER :: k Be2 = Be * Be CosBK2 = CosBK * CosBK DO k = 1, Predictor_TL%n_Layers ! Predictors associated Temperature OneOverT = 300.0_fp / Temperature(k) OneOverT_TL = -(OneOverT / Temperature(k))*Temperature_TL(k) Predictor_TL%X(k, 1, 1) = OneOverT_TL Predictor_TL%X(k, 2, 1) = OneOverT_TL * CosBK2 Predictor_TL%X(k, 3, 1) = OneOverT_TL / Be Predictor_TL%X(k, 4, 1) = OneOverT_TL * CosBK / Be Predictor_TL%X(k, 5, 1) = OneOverT_TL * CosBK / Be2 END DO ! Constant predictor Predictor_TL%X(:, 6:18, 1) = ZERO Predictor_TL%n_CP(1) = MAX_N_PREDICTORS_ZSSMIS END SUBROUTINE Compute_Predictors_zssmis_TL !------------------------------------------------------------------------------ ! ! NAME: ! Compute_Predictors_zssmis_AD ! ! PURPOSE: ! Subroutine to compute AD predictors for the ZSSMIS sensor (a virtual sensor ! created for SSMIS Zeeman channels 19, 20, 21 and 22) ! ! CALLING SEQUENCE: ! ! CALL Compute_Predictors_zssmis_AD(Temperature, & ! Be, & ! CosBK, & ! Predictor_AD, & ! Temperature_AD ) ! INPUT ARGUMENTS: ! ! Temperature: Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Be : Earth magnetic filed strength ! UNITS: Guass (range 0.2 - 0.7) ! TYPE: REAL(fp) ! DIMENSION: scalar ! ATTRIBUTES: INTENT(IN) ! ! CosBK : Cosine of the angle between the Earth magnetic ! field and the electromagnetic wave propagation ! direction ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Predictor_AD: AD Predictor structure ! UNITS: N/A ! TYPE: TYPE(ODPS_Predictor_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(INOUT) ! ! OUTPUT ARGUMENTS: ! Temperature_AD: AD Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(INOUT) ! !------------------------------------------------------------------------------ SUBROUTINE Compute_Predictors_zssmis_AD(Temperature, & Be, & CosBK, & Predictor_AD, & Temperature_AD ) REAL(fp), INTENT( IN ) :: Temperature(:) REAL(fp), INTENT( IN ) :: Be REAL(fp), INTENT( IN ) :: CosBK TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor_AD REAL(fp), INTENT( INOUT ) :: Temperature_AD(:) ! LOCAL REAL(fp) :: Be2, CosBK2, OneOverT, OneOverT_AD INTEGER :: k Be2 = Be * Be CosBK2 = CosBK * CosBK DO k = 1, Predictor_AD%n_Layers ! Predictors associated Temperature OneOverT = 300.0_fp / Temperature(k) OneOverT_AD = Predictor_AD%X(k, 1, 1) + & Predictor_AD%X(k, 2, 1)*CosBK2 + & Predictor_AD%X(k, 3, 1) / Be + & Predictor_AD%X(k, 4, 1) * CosBK / Be + & Predictor_AD%X(k, 5, 1) * CosBK / Be2 Temperature_AD(k) = Temperature_AD(k) - & (OneOverT / Temperature(k)) * OneOverT_AD END DO ! Constant predictor Predictor_AD%X(:, :, 1) = ZERO Predictor_AD%n_CP(1) = MAX_N_PREDICTORS_ZSSMIS END SUBROUTINE Compute_Predictors_zssmis_AD !------------------------------------------------------------------------------ ! ! NAME: ! Compute_Predictors_zamsua ! ! PURPOSE: ! Subroutine to compute predictors for the ZAMSUA sensor (a virtual sensor ! with AMSUA channel 14) ! ! CALLING SEQUENCE: ! CALL Compute_Predictors_zamsua(Temperature, & ! Ref_Temperature, & ! Be, & ! CosBK, & ! Secang, & ! Predictor ) ! ! INPUT ARGUMENTS: ! ! Temperature: Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Ref_Temperature: Reference temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Be : Earth magnetic filed strength ! UNITS: Guass (range 0.2 - 0.7) ! TYPE: REAL(fp) ! DIMENSION: scalar ! ATTRIBUTES: INTENT(IN) ! ! CosBK : Cosine of the angle between the Earth magnetic ! field and the electromagnetic wave propagation ! direction ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! Secang : Secant of the zenith angle profile ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! OUTPUT ARGUMENTS: ! Predictor: Predictor structure ! UNITS: N/A ! TYPE: TYPE(ODPS_Predictor_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! !------------------------------------------------------------------------------ SUBROUTINE Compute_Predictors_zamsua(Temperature, & Ref_Temperature, & Be, & CosBK, & Secang, & Predictor ) REAL(fp), INTENT( IN ) :: Temperature(:) REAL(fp), INTENT( IN ) :: Ref_Temperature(:) REAL(fp), INTENT( IN ) :: Be REAL(fp), INTENT( IN ) :: CosBK REAL(fp), INTENT( IN ) :: Secang(:) TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor ! LOCAL REAL(fp) :: Be3, CosBK2, CosBK2Be2, tk INTEGER :: k Be3 = Be*Be*Be CosBK2 = CosBK*CosBK CosBK2Be2 = CosBK2*Be*Be DO k = 1, Predictor%n_Layers tk = Temperature(k)/Ref_Temperature(k) Predictor%X(k, 1, 1) = Secang(k) Predictor%X(k, 2, 1) = tk Predictor%X(k, 3, 1) = tk*tk Predictor%X(k, 4, 1) = CosBK2 Predictor%X(k, 5, 1) = Be*Secang(k) Predictor%X(k, 6, 1) = Be3 Predictor%X(k, 7, 1) = CosBK2Be2*Secang(k) END DO Predictor%n_CP(1) = MAX_N_PREDICTORS_ZAMSUA Predictor%Secant_Zenith = Secang END SUBROUTINE Compute_Predictors_zamsua !------------------------------------------------------------------------------ ! ! NAME: ! Compute_Predictors_zamsua_TL ! ! PURPOSE: ! Subroutine to compute TL predictors for the ZAMSUA sensor (a virtual sensor ! with AMSUA channel 14) ! ! CALLING SEQUENCE: ! ! CALL Compute_Predictors_zamsua_TL(Temperature, & ! Ref_Temperature, & ! Temperature_TL,& ! Predictor_TL ) ! INPUT ARGUMENTS: ! ! Temperature: Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! RefTemperature: Reference temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Temperature_TL: TL Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! OUTPUT ARGUMENTS: ! Predictor_TL: TL Predictor structure ! UNITS: N/A ! TYPE: TYPE(ODPS_Predictor_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! !------------------------------------------------------------------------------ SUBROUTINE Compute_Predictors_zamsua_TL(Temperature, & Ref_Temperature, & Temperature_TL, & Predictor_TL ) REAL(fp), INTENT( IN ) :: Temperature(:) REAL(fp), INTENT( IN ) :: Ref_Temperature(:) REAL(fp), INTENT( IN ) :: Temperature_TL(:) TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor_TL ! LOCAL REAL(fp) :: tk, tk_TL INTEGER :: k DO k = 1, Predictor_TL%n_Layers tk = Temperature(k)/Ref_Temperature(k) tk_TL = Temperature_TL(k)/Ref_Temperature(k) Predictor_TL%X(k, 1, 1) = ZERO Predictor_TL%X(k, 2, 1) = tk_TL Predictor_TL%X(k, 3, 1) = TWO*tk*tk_TL Predictor_TL%X(k, 4, 1) = ZERO Predictor_TL%X(k, 5, 1) = ZERO Predictor_TL%X(k, 6, 1) = ZERO Predictor_TL%X(k, 7, 1) = ZERO END DO Predictor_TL%n_CP(1) = MAX_N_PREDICTORS_ZAMSUA END SUBROUTINE Compute_Predictors_zamsua_TL !------------------------------------------------------------------------------ ! ! NAME: ! Compute_Predictors_zamsua_AD ! ! PURPOSE: ! Subroutine to compute AD predictors for the ZAMSUA sensor (a virtual sensor ! with AMSUA channel 14) ! ! CALLING SEQUENCE: ! ! CALL Compute_Predictors_zamsua_AD(Temperature, & ! Ref_Temperature, & ! Predictor_AD, & ! Temperature_AD ) ! INPUT ARGUMENTS: ! ! Temperature: Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Ref_Temperature: Reference temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(IN) ! ! Predictor_AD: AD Predictor structure ! UNITS: N/A ! TYPE: TYPE(ODPS_Predictor_type) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(INOUT) ! ! OUTPUT ARGUMENTS: ! Temperature_AD: AD Temperature profile ! UNITS: K ! TYPE: REAL(fp) ! DIMENSION: Rank-1(n_Layers) array ! ATTRIBUTES: INTENT(INOUT) ! !------------------------------------------------------------------------------ SUBROUTINE Compute_Predictors_zamsua_AD(Temperature, & Ref_Temperature,& Predictor_AD, & Temperature_AD ) REAL(fp), INTENT( IN ) :: Temperature(:) REAL(fp), INTENT( IN ) :: Ref_Temperature(:) TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor_AD REAL(fp), INTENT( INOUT ) :: Temperature_AD(:) ! LOCAL REAL(fp) :: tk, tk_AD INTEGER :: k DO k = Predictor_AD%n_Layers, 1, -1 tk = Temperature(k)/Ref_Temperature(k) tk_AD = TWO*tk*Predictor_AD%X(k, 3, 1) tk_AD = tk_AD + Predictor_AD%X(k, 2, 1) Temperature_AD(k) = Temperature_AD(k) + tk_AD/Ref_Temperature(k) Predictor_AD%X(k, :, 1) = ZERO END DO Predictor_AD%n_CP(1) = MAX_N_PREDICTORS_ZAMSUA END SUBROUTINE Compute_Predictors_zamsua_AD END MODULE ODZeeman_Predictor