var/da/da_physics/da_sfc_pre_adj.inc

   1 subroutine da_sfc_pre_adj (psfcm_prime, psm_prime, tsm_prime, qsm_prime, &
   2    psm, tsm, qsm, hsm, ho, to, qvo)
   3
   4    !-----------------------------------------------------------------------
   5    ! Purpose: TBD
   6    !-----------------------------------------------------------------------
   7
   8    !---------------------------------------------------------------------------
   9    !
  10    ! Correct pressure between two levels.
  11    !
  12    ! Reference: make use of the hydrosatic equation:
  13    !
  14    !  P2 = P1 * exp [-G/R * (z2-z1) / (tv1 + tv2)/2)
  15    !
  16    ! Where:
  17    !  z1  = height at level 1
  18    !  z1  = height at level 2
  19    !  tv1 = temperature at level 1
  20    !  tv2 = temperature at level 2
  21    !  P1  = Pressure at level 1
  22    !  P2  = Pressure at level 2
  23    !---------------------------------------------------------------------------
  24
  25    implicit none
  26
  27    ! Perturbation:
  28    real, intent (in)     :: psfcm_prime          ! model pressure at ho
  29    real, intent (inout)  :: psm_prime, tsm_prime, qsm_prime            ! model surface p, t, q
  30    ! Basic state:
  31    real, intent (in)     :: psm, tsm, qsm        ! model pressure at ho and
  32                                                  ! model surface p, t, q
  33    ! Constant variables:
  34    real, intent (in)           :: hsm, ho
  35    real, intent (in), optional :: to, qvo
  36    ! working array:
  37    real                 :: tvo, tvsm, tv, dz, arg0
  38    real                 :: tvsm_prime, tvo_prime, tv_prime, arg, arg_prime
  39
  40    real, parameter      :: GASR =  gas_constant
  41    real, parameter      :: G = gravity
  42
  43    if (trace_use) call da_trace_entry("da_sfc_pre_adj")
  44
  45    !---------------------------------------------------------------------------
  46    ! 1.0 Basic state
  47    ! --------------------------------------------------------------------------
  48
  49    ! 1.1  MODEL AND OBSERVATION VIRTUAL TEMPERATURE
  50    ! ---------------------------------------------
  51
  52    tvsm = tsm  * (1.0 + 0.608 * qsm)
  53
  54    if (present(to) .and. present(qvo)) then
  55       tvo = to  * (1.0 + 0.608 * qvo)
  56    else if (present(to) .and. .not.present(qvo)) then
  57       tvo = to
  58    else
  59       tvo = tvsm
  60    end if
  61
  62    ! 1.2  Mean virtual temperature
  63    ! ----------------------------
  64
  65    tv  = 0.5 * (tvsm + tvo)
  66
  67    ! 1.3  Compute (g/RTv) * dZ
  68    ! --------------------------
  69
  70    dz = hsm - ho
  71    arg0 = dz * g / gasr
  72    arg =  arg0    / tv
  73
  74    ! ---------------------------------------------------------------------------|
  75    ! 2.0 Adjoint
  76    ! ---------------------------------------------------------------------------|
  77
  78    ! 2.1  psfcm_prime ==> psm_prime, arg_prime
  79    ! -----------------------------------------
  80
  81    arg_prime = exp(arg) * psm * psfcm_prime
  82    psm_prime = exp(arg) * psfcm_prime + psm_prime
  83
  84    ! 2.2 arg_prim ==> tv_prime
  85    ! -------------------------
  86
  87    tv_prime = - arg0 * arg_prime / (tv * tv)
  88
  89    ! 2.3 tv_prime ==> tvsm_prime, tvo_prime
  90    ! --------------------------------------
  91
  92    tvsm_prime = 0.5 * tv_prime
  93    tvo_prime  = 0.5 * tv_prime
  94
  95    ! 2.4 tvo_prime ==> tsm_prime
  96    ! ---------------------------
  97
  98    if (present(to) .and. present(qvo)) then
  99       tvo_prime = 0.0
 100    else if (present(to) .and. .not.present(qvo)) then
 101       tvo_prime = 0.0
 102    else
 103       tvsm_prime = tvo_prime + tvsm_prime
 104    end if
 105
 106    ! 2.5 tvsm_prime ==>  tsm_prime, qsm_prime
 107    ! ----------------------------------------
 108
 109    tsm_prime = tvsm_prime * (1.0 + 0.608 * qsm) + tsm_prime
 110    qsm_prime = tvsm_prime * tsm * 0.608 + qsm_prime
 111
 112    if (trace_use) call da_trace_exit("da_sfc_pre_adj")
 113
 114 end subroutine da_sfc_pre_adj
 115
 116