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