1 |
|
2 |
SUBROUTINE cv_unsat(nloc,ncum,nd,inb,t,q,qs,gz,u,v,p,ph & |
3 |
,h,lv,ep,sigp,clw,m,ment,elij & |
4 |
,iflag,mp,qp,up,vp,wt,water,evap) |
5 |
use cvthermo |
6 |
use cv_param |
7 |
implicit none |
8 |
|
9 |
|
10 |
|
11 |
! inputs: |
12 |
integer, intent(in):: ncum, nd, nloc |
13 |
integer inb(nloc) |
14 |
real t(nloc,nd), q(nloc,nd), qs(nloc,nd) |
15 |
real gz(nloc,nd), u(nloc,nd), v(nloc,nd) |
16 |
real p(nloc,nd), ph(nloc,nd+1), h(nloc,nd) |
17 |
real lv(nloc,nd), ep(nloc,nd), sigp(nloc,nd), clw(nloc,nd) |
18 |
real m(nloc,nd), ment(nloc,nd,nd), elij(nloc,nd,nd) |
19 |
|
20 |
! outputs: |
21 |
integer iflag(nloc) ! also an input |
22 |
real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd) |
23 |
real water(nloc,nd), evap(nloc,nd), wt(nloc,nd) |
24 |
|
25 |
! local variables: |
26 |
integer i,j,k,ij,num1 |
27 |
integer jtt(nloc) |
28 |
real awat, coeff, qsm, afac, sigt, b6, c6, revap |
29 |
real dhdp, fac, qstm, rat |
30 |
real wdtrain(nloc) |
31 |
logical lwork(nloc) |
32 |
|
33 |
!===================================================================== |
34 |
! --- PRECIPITATING DOWNDRAFT CALCULATION |
35 |
!===================================================================== |
36 |
! |
37 |
! Initializations: |
38 |
! |
39 |
do i = 1, ncum |
40 |
do k = 1, nl+1 |
41 |
wt(i,k) = omtsnow |
42 |
mp(i,k) = 0.0 |
43 |
evap(i,k) = 0.0 |
44 |
water(i,k) = 0.0 |
45 |
enddo |
46 |
enddo |
47 |
|
48 |
do 420 i=1,ncum |
49 |
qp(i,1)=q(i,1) |
50 |
up(i,1)=u(i,1) |
51 |
vp(i,1)=v(i,1) |
52 |
420 continue |
53 |
|
54 |
do 440 k=2,nl+1 |
55 |
do 430 i=1,ncum |
56 |
qp(i,k)=q(i,k-1) |
57 |
up(i,k)=u(i,k-1) |
58 |
vp(i,k)=v(i,k-1) |
59 |
430 continue |
60 |
440 continue |
61 |
|
62 |
|
63 |
! *** Check whether ep(inb)=0, if so, skip precipitating *** |
64 |
! *** downdraft calculation *** |
65 |
! |
66 |
! |
67 |
! *** Integrate liquid water equation to find condensed water *** |
68 |
! *** and condensed water flux *** |
69 |
! |
70 |
! |
71 |
do 890 i=1,ncum |
72 |
jtt(i)=2 |
73 |
if(ep(i,inb(i)).le.0.0001)iflag(i)=2 |
74 |
if(iflag(i).eq.0)then |
75 |
lwork(i)=.true. |
76 |
else |
77 |
lwork(i)=.false. |
78 |
endif |
79 |
890 continue |
80 |
! |
81 |
! *** Begin downdraft loop *** |
82 |
! |
83 |
! |
84 |
call zilch(wdtrain,ncum) |
85 |
do 899 i=nl+1,1,-1 |
86 |
! |
87 |
num1=0 |
88 |
do 879 ij=1,ncum |
89 |
if((i.le.inb(ij)).and.lwork(ij))num1=num1+1 |
90 |
879 continue |
91 |
if(num1.le.0)go to 899 |
92 |
! |
93 |
! |
94 |
! *** Calculate detrained precipitation *** |
95 |
! |
96 |
do 891 ij=1,ncum |
97 |
if((i.le.inb(ij)).and.(lwork(ij)))then |
98 |
wdtrain(ij)=g*ep(ij,i)*m(ij,i)*clw(ij,i) |
99 |
endif |
100 |
891 continue |
101 |
! |
102 |
if(i.gt.1)then |
103 |
do 893 j=1,i-1 |
104 |
do 892 ij=1,ncum |
105 |
if((i.le.inb(ij)).and.(lwork(ij)))then |
106 |
awat=elij(ij,j,i)-(1.-ep(ij,i))*clw(ij,i) |
107 |
awat=max(0.0,awat) |
108 |
wdtrain(ij)=wdtrain(ij)+g*awat*ment(ij,j,i) |
109 |
endif |
110 |
892 continue |
111 |
893 continue |
112 |
endif |
113 |
! |
114 |
! *** Find rain water and evaporation using provisional *** |
115 |
! *** estimates of qp(i)and qp(i-1) *** |
116 |
! |
117 |
! |
118 |
! *** Value of terminal velocity and coeffecient of evaporation for snow *** |
119 |
! |
120 |
do 894 ij=1,ncum |
121 |
if((i.le.inb(ij)).and.(lwork(ij)))then |
122 |
coeff=coeffs |
123 |
wt(ij,i)=omtsnow |
124 |
! |
125 |
! *** Value of terminal velocity and coeffecient of evaporation for rain *** |
126 |
! |
127 |
if(t(ij,i).gt.273.0)then |
128 |
coeff=coeffr |
129 |
wt(ij,i)=omtrain |
130 |
endif |
131 |
qsm=0.5*(q(ij,i)+qp(ij,i+1)) |
132 |
afac=coeff*ph(ij,i)*(qs(ij,i)-qsm) & |
133 |
/(1.0e4+2.0e3*ph(ij,i)*qs(ij,i)) |
134 |
afac=max(afac,0.0) |
135 |
sigt=sigp(ij,i) |
136 |
sigt=max(0.0,sigt) |
137 |
sigt=min(1.0,sigt) |
138 |
b6=100.*(ph(ij,i)-ph(ij,i+1))*sigt*afac/wt(ij,i) |
139 |
c6=(water(ij,i+1)*wt(ij,i+1)+wdtrain(ij)/sigd)/wt(ij,i) |
140 |
revap=0.5*(-b6+sqrt(b6*b6+4.*c6)) |
141 |
evap(ij,i)=sigt*afac*revap |
142 |
water(ij,i)=revap*revap |
143 |
! |
144 |
! *** Calculate precipitating downdraft mass flux under *** |
145 |
! *** hydrostatic approximation *** |
146 |
! |
147 |
if(i.gt.1)then |
148 |
dhdp=(h(ij,i)-h(ij,i-1))/(p(ij,i-1)-p(ij,i)) |
149 |
dhdp=max(dhdp,10.0) |
150 |
mp(ij,i)=100.*ginv*lv(ij,i)*sigd*evap(ij,i)/dhdp |
151 |
mp(ij,i)=max(mp(ij,i),0.0) |
152 |
! |
153 |
! *** Add small amount of inertia to downdraft *** |
154 |
! |
155 |
fac=20.0/(ph(ij,i-1)-ph(ij,i)) |
156 |
mp(ij,i)=(fac*mp(ij,i+1)+mp(ij,i))/(1.+fac) |
157 |
! |
158 |
! *** Force mp to decrease linearly to zero *** |
159 |
! *** between about 950 mb and the surface *** |
160 |
! |
161 |
if(p(ij,i).gt.(0.949*p(ij,1)))then |
162 |
jtt(ij)=max(jtt(ij),i) |
163 |
mp(ij,i)=mp(ij,jtt(ij))*(p(ij,1)-p(ij,i)) & |
164 |
/(p(ij,1)-p(ij,jtt(ij))) |
165 |
endif |
166 |
endif |
167 |
! |
168 |
! *** Find mixing ratio of precipitating downdraft *** |
169 |
! |
170 |
if(i.ne.inb(ij))then |
171 |
if(i.eq.1)then |
172 |
qstm=qs(ij,1) |
173 |
else |
174 |
qstm=qs(ij,i-1) |
175 |
endif |
176 |
if(mp(ij,i).gt.mp(ij,i+1))then |
177 |
rat=mp(ij,i+1)/mp(ij,i) |
178 |
qp(ij,i)=qp(ij,i+1)*rat+q(ij,i)*(1.0-rat)+100.*ginv* & |
179 |
sigd*(ph(ij,i)-ph(ij,i+1))*(evap(ij,i)/mp(ij,i)) |
180 |
up(ij,i)=up(ij,i+1)*rat+u(ij,i)*(1.-rat) |
181 |
vp(ij,i)=vp(ij,i+1)*rat+v(ij,i)*(1.-rat) |
182 |
else |
183 |
if(mp(ij,i+1).gt.0.0)then |
184 |
qp(ij,i)=(gz(ij,i+1)-gz(ij,i) & |
185 |
+qp(ij,i+1)*(lv(ij,i+1)+t(ij,i+1) & |
186 |
*(cl-cpd))+cpd*(t(ij,i+1)-t(ij,i))) & |
187 |
/(lv(ij,i)+t(ij,i)*(cl-cpd)) |
188 |
up(ij,i)=up(ij,i+1) |
189 |
vp(ij,i)=vp(ij,i+1) |
190 |
endif |
191 |
endif |
192 |
qp(ij,i)=min(qp(ij,i),qstm) |
193 |
qp(ij,i)=max(qp(ij,i),0.0) |
194 |
endif |
195 |
endif |
196 |
894 continue |
197 |
899 continue |
198 |
! |
199 |
return |
200 |
end |