da_cumulus.inc
References to this file elsewhere.
1 subroutine da_cumulus (ZCB, TCB, QCB, PCB, PK, TE, &
2 Z, T, Q, LCB, LCT, PCT, ZCT, kts, kte)
3
4 !-----------------------------------------------------------------------
5 ! Purpose: TBD
6 !-----------------------------------------------------------------------
7
8 implicit none
9
10 integer, intent(in) :: kts, kte
11 real, intent(inout) :: ZCB, TCB, QCB, PCB
12 real, intent(in), dimension(kts:kte) :: PK, TE
13 real, intent(out), dimension(kts:kte) :: Z, T, Q
14 integer, intent(out) :: LCB, LCT
15 real, intent(out) :: PCT, ZCT
16
17 integer :: k, IA, L, NCB
18 real :: G, CP, R, HL, EM, ET, P
19 real :: TLL, QLL, PLL, ZLL, TBAR, PBAR, QBAR
20 real :: DP, DZ, DDT, DT
21
22 G=9.81
23 CP=1004.
24 R=2000./7.
25 HL=2.49E06
26 DT=0.1
27 IA=1000
28
29 do k = kts, kte
30 Z(k) = 0.0
31 T(k) = 0.0
32 Q(k) = 0.0
33 end do
34
35 EM=G*ZCB+CP*TCB+HL*QCB
36
37 NCB=kts
38
39 if (PK(kte) > PCB) then
40 NCB=kte
41 end if
42
43 do L=kte-1,kts,-1
44 if (PK(L) > PCB) then
45 NCB=L+1
46 exit
47 end if
48 end do
49
50 do L=NCB,kte
51 P=PK(L)
52 do K=1,IA
53 if (L == NCB) then
54 TLL=TCB
55 QLL=QCB
56 PLL=PCB
57 ZLL=ZCB
58 else
59 TLL=T(L-1)
60 QLL=Q(L-1)
61 PLL=PK(L-1)
62 ZLL=Z(L-1)
63 end if
64
65 T(L)=TLL-(K*DT)
66
67 call da_qfrmrh(P, T(L), 100., Q(L))
68
69 TBAR=0.5*(T(L)+TLL)
70 QBAR=0.5*(Q(L)+QLL)
71 PBAR=0.5*(P+PLL)
72 DP=PLL-P
73 DZ=(R*TBAR*(1.+0.61*QBAR)*DP)/(G*PBAR)
74 Z(L)=ZLL+DZ
75 ET=G*Z(L)+CP*T(L)+HL*Q(L)
76 if ((ET-EM) <= 0.) exit
77 end do
78 end do
79
80 LCT=NCB
81
82 do K=kte,NCB+1,-1
83 DDT=T(K)-TE(K)
84
85 if (DDT >= 0.) then
86 LCT=K
87 exit
88 end if
89 end do
90
91 LCB=LCT
92
93 do K=NCB,kte
94 DDT=T(K)-TE(K)
95 if (DDT >= 0.) then
96 LCB=K
97 exit
98 end if
99 end do
100
101 PCT=PK(LCT)
102 ZCT=Z(LCT)
103 PCB=PK(LCB)
104 ZCB=Z(LCB)
105
106 end subroutine da_cumulus
107
108