ODZeeman_Predictor.f90

Go to the documentation of this file.

!
! 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