da_sfc_pre_adj.inc

References to this file elsewhere.
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, &
30                             qsm_prime            ! model surface p, t, q 
31    ! Basic state:
32    real, intent (in)     :: psm, tsm, qsm        ! model pressure at ho and
33                                                  ! model surface p, t, q 
34    ! Constant variables:
35    real, intent (in)           :: hsm, ho
36    real, intent (in), optional :: to, qvo
37    ! working array:
38    real                 :: tvo, tvsm, tv, dz, arg0
39    real                 :: tvsm_prime, tvo_prime, tv_prime, arg, arg_prime
40 
41    real, parameter      :: GASR =  gas_constant
42    real, parameter      :: G = gravity
43 
44    !---------------------------------------------------------------------------
45    ! 1.0 Basic state
46    ! --------------------------------------------------------------------------
47 
48    ! 1.1  MODEL AND OBSERVATION VIRTUAL TEMPERATURE
49    ! ---------------------------------------------
50 
51    tvsm = tsm  * (1.0 + 0.608 * qsm)
52 
53    if (present(to) .and. present(qvo)) then
54       tvo = to  * (1.0 + 0.608 * qvo)
55    else if (present(to) .and. .not.present(qvo)) then
56       tvo = to
57    else
58       tvo = tvsm
59    end if
60 
61    ! 1.2  Mean virtual temperature
62    ! ----------------------------
63 
64    tv  = 0.5 * (tvsm + tvo)
65 
66    ! 1.3  Compute (g/RTv) * dZ
67    ! --------------------------
68 
69    dz = hsm - ho
70    arg0 = dz * g / gasr     
71    arg =  arg0    / tv
72 
73    ! ---------------------------------------------------------------------------|
74    ! 2.0 Adjoint
75    ! ---------------------------------------------------------------------------|
76 
77    ! 2.1  psfcm_prime ==> psm_prime, arg_prime
78    ! -----------------------------------------
79 
80    arg_prime = exp(arg) * psm * psfcm_prime
81    psm_prime = exp(arg) * psfcm_prime + psm_prime
82 
83    ! 2.2 arg_prim ==> tv_prime
84    ! -------------------------
85 
86    tv_prime = - arg0 * arg_prime / (tv * tv)
87 
88    ! 2.3 tv_prime ==> tvsm_prime, tvo_prime
89    ! --------------------------------------
90 
91    tvsm_prime = 0.5 * tv_prime
92    tvo_prime  = 0.5 * tv_prime
93 
94    ! 2.4 tvo_prime ==> tsm_prime
95    ! ---------------------------
96 
97    if (present(to) .and. present(qvo)) then
98       tvo_prime = 0.0
99    else if (present(to) .and. .not.present(qvo)) then
100       tvo_prime = 0.0
101    else
102       tvsm_prime = tvo_prime + tvsm_prime
103    end if
104 
105    ! 2.5 tvsm_prime ==>  tsm_prime, qsm_prime
106    ! ----------------------------------------
107 
108    tsm_prime = tvsm_prime * (1. + 0.608 * qsm) + tsm_prime
109    qsm_prime = tvsm_prime * tsm * 0.608 + qsm_prime
110 
111 end subroutine da_sfc_pre_adj
112 
113