da_tpq_to_slp_adj.inc
References to this file elsewhere.
1 subroutine da_tpq_to_slp_adj ( T, Q, P, TERR, PSFC, &
2 T9, Q9, P9, PSFC9, SLP9, xp )
3
4 !-----------------------------------------------------------------------
5 ! Purpose: computes sea level pressure from the rule
6 ! t1/t2=(p1/p2)**(gamma*r/g).
7 !
8 ! input t temperature
9 ! q mixing ratio
10 ! p pressure
11 ! terr terrain
12 ! psfc surface pressure
13 !
14 ! output slp sea level pressure
15 !
16 !-----------------------------------------------------------------------
17
18 implicit none
19
20 type (xpose_type), intent(in) :: xp
21 real, intent(in) :: TERR, PSFC
22 real, dimension(xp%kms:xp%kme), intent(in) :: T, Q, P
23 real, dimension(xp%kms:xp%kme), intent(out) :: T9, Q9, P9
24 ! real :: SLP
25 real, intent(in) :: SLP9
26 real, intent(out) :: PSFC9
27
28 integer :: K, KLO, KHI
29 real :: PL, T0, TS, XTERM, &
30 TLO, THI, TL
31 real :: PL9,T09,TS9,TLO9,THI9,TL9,COEF1,COEF2
32 real :: T08,TS8
33
34 real, parameter :: GAMMA = 6.5E-3, &
35 TC=t_kelvin+17.5, &
36 PCONST=10000. , &
37 EPS = 0.622
38
39 ! SEA LEVEL PRESSURE
40
41 XTERM=GAMMA* gas_constant / gravity
42
43 ! COMPUTE PRESSURE AT PCONST MB ABOVE SURFACE (PL)
44
45 T9(:)=0.
46 Q9(:)=0.
47 P9(:)=0.
48
49 if (terr <= 0.) then
50 psfc9=slp9
51 return
52 end if
53
54 PL = psfc - PCONST
55 klo = 0
56
57 ! FinD 2 LEVELS ON SIGMA SURFACES SURROUNDinG PL AT EACH I,J
58
59 k_loop: do k=xp%kts, xp%kte-1
60 if ((p(k) >= pl) .and. (p(k+1) < pl)) then
61 khi = k+1
62 klo = k
63 exit k_loop
64 end if
65 end do k_loop
66
67 if (klo < 1) then
68 write(unit=message(1),fmt='(A,F11.3,A)') &
69 'ERROR FinDinG PRESSURE LEVEL ',PCONST,' MB ABOVE THE SURFACE'
70 write(unit=message(2),fmt='(A,F11.3,2X,A,F11.3)') &
71 'PL=',PL,' PSFC=',psfc
72 call da_error(__FILE__,__LINE__,message(1:2))
73 end if
74
75 ! GET TEMPERATURE AT PL (TL), EXTRAPOLATE T AT SURFACE (TS)
76 ! AND T AT SEA LEVEL (T0) WITH 6.5 K/KM LAPSE RATE
77
78 TLO=t(KLO) * (EPS+q(KLO))/(EPS*(1.+q(KLO)))
79 THI=t(KHI) * (EPS+q(KHI))/(EPS*(1.+q(KHI)))
80 COEF1=ALOG(PL/p(KHI))
81 COEF2=ALOG(p(KLO)/p(KHI))
82 TL=THI-(THI-TLO)*COEF1/COEF2
83 TS=TL*(psfc/PL)**XTERM
84 TS8=TS
85 T0=TS +GAMMA*terr
86 T08=T0
87
88 ! CORRECT SEA LEVEL TEMPERATURE if TOO HOT
89
90 if ( t0 >= tc ) then
91 if ( ts <= tc ) then
92 t0 = tc
93 else
94 t0 = tc-0.005*(ts-tc)**2
95 end if
96 end if
97
98 psfc9=slp9*EXP(2.*gravity*TERR/(gas_constant*(TS+T0)))
99 TS9=-slp9*psfc*EXP(2.*gravity*TERR/(gas_constant*(TS+T0)))* &
100 2.*gravity*TERR/(gas_constant*(TS+T0)**2)
101 T09=-slp9*psfc*EXP(2.*gravity*TERR/(gas_constant*(TS+T0)))* &
102 2.*gravity*TERR/(gas_constant*(TS+T0)**2)
103
104 if ( t08 >= tc ) then
105 if ( ts8 > tc ) then
106 ts9=ts9-0.01*(ts-tc)*t09
107 end if
108 t09=0.
109 end if
110
111 TS9=TS9+T09
112 TL9=TS9*(psfc/PL)**XTERM
113 psfc9=psfc9+TS9*XTERM*(TL/PL)*(psfc/PL)**(XTERM-1)
114 PL9=-TS9*XTERM*(TL*psfc/(PL*PL))*(psfc/PL)**(XTERM-1)
115 THI9=(1.0-COEF1/COEF2)*TL9
116 TLO9=COEF1/COEF2*TL9
117 PL9=PL9-(THI-TLO)/(COEF2*PL)*TL9
118 p9(KHI)=p9(KHI)+((THI-TLO)/(COEF2*p(KHI))*(1.-COEF1/COEF2))*TL9
119 p9(KLO)=p9(KLO)+(THI-TLO)*COEF1/(COEF2*COEF2*p(KLO))*TL9
120 t9(KHI)=t9(KHI)+THI9* (EPS+q(KHI))/(EPS*(1.+q(KHI)))
121 q9(KHI)=q9(KHI)+THI9*t(KHI)*(1.0-EPS)/(EPS*(1.+q(KHI))**2)
122 t9(KLO)=t9(KLO)+TLO9* (EPS+q(KLO))/(EPS*(1.+q(KLO)))
123 q9(KLO)=q9(KLO)+TLO9*t(KLO)*(1.0-EPS)/(EPS*(1.+q(KLO))**2)
124
125 psfc9=psfc9+PL9
126
127 end subroutine da_tpq_to_slp_adj
128
129