da_intpsfc_prs.inc

1 subroutine da_intpsfc_prs (val, ho, po, hm, tm, qm, to, qo)
2 
3    !----------------------------------------------------------------------------
4    ! Purpose: Correct pressure between two levels. 
5    !
6    ! Reference: make use of the hydrosatic equation:
7    !
8    !  P2 = P1 * exp [-G/R * (z2-z1) / (tv1 + tv2)/2)
9    !
10    ! Where:
11    !  z1  = height at level 1
12    !  z1  = height at level 2
13    !  tv1 = temperature at level 1
14    !  tv2 = temperature at level 2
15    !  P1  = Pressure at level 1
16    !  P2  = Pressure at level 2
17    !----------------------------------------------------------------------------
18 
19    implicit none
20 
21    real, intent (out)          :: val
22    real, intent (in)           :: ho, po
23    real, intent (in)           :: hm, tm, qm    
24    real, intent (in), optional :: to, qo
25 
26    real :: tvo, tvm, tv, dz, arg
27 
28    if (trace_use) call da_trace_entry("da_intpsfc_prs")
29 
30    ! 1.  model and observation virtual temperature
31    ! ---------------------------------------------
32 
33    tvm = tm  * (1.0 + 0.608 * qm)
34    if (present(to) .and. present(qo)) then
35       tvo = to  * (1.0 + 0.608 * qo)
36    else if (present(to) .and. .not.present(qo)) then
37       tvo = to
38    else
39       tvo = tvm
40    end if
41 
42    tv  = 0.5 * (tvm + tvo)
43 
44    ! 2. height difference bewteen model surface and observations
45    ! ------------------------------------------------------------
46 
47    dz = hm - ho
48  
49    ! 3.  extrapolate pressure obs to model surface
50    ! ---------------------------------------------
51 
52    arg = dz * gravity / gas_constant
53    arg = arg    / tv 
54 
55    val = po * exp (-arg)
56 
57    if (trace_use) call da_trace_exit("da_intpsfc_prs")
58 
59 end subroutine da_intpsfc_prs
60 
61