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