da_intpsfc_prs.inc

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