Context Navigation

cv3p_mixing.f90 @ 5840

Last change on this file since 5840 was 5840, checked in by jyg, 2 months ago
Getting rid of tracer arrays within cva_driver. Lot of comments to be cleared later.
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 24.5 KB

Line
1	MODULE cv3p_mixing_mod
2	PRIVATE
3	PUBLIC cv3p_mixing
4	CONTAINS
5
6	SUBROUTINE cv3p_mixing_pre
7
8	END SUBROUTINE cv3p_mixing_pre
9
10	!!SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, & !jyg: get rid of ntra
11	SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, icb, nk, inb, &
12	!! ph, t, rr, rs, u, v, tra, h, lv, lf, frac, qta, & !jyg: get rid of ntra
13	ph, t, rr, rs, u, v, h, lv, lf, frac, qta, &
14	unk, vnk, hp, tv, tvp, ep, clw, sig, &
15	Ment, Qent, hent, uent, vent, nent, &
16	!! Sigij, elij, supmax, Ments, Qents, traent) !jyg: get rid of ntra
17	Sigij, elij, supmax, Ments, Qents)
18	! **************************************************************
19	! *
20	! CV3P_MIXING : compute mixed draught properties and, *
21	! within a scaling factor, mixed draught *
22	! mass fluxes. *
23	! written by : VTJ Philips,JY Grandpeix, 21/05/2003, 09.14.15*
24	! modified by : *
25	! **************************************************************
26
27	USE yomcst2_mod_h, ONLY : Fmax, gammas, scut, qqa1, qqa2
28	USE lmdz_cv_ini, ONLY : cpd,cpv,minorig,nl,rrv
29	USE cvflag_mod_h
30	USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
31	USE ioipsl_getin_p_mod, ONLY: getin_p
32	USE add_phys_tend_mod, ONLY: fl_cor_ebil
33
34	IMPLICIT NONE
35
36
37	!inputs:
38	INTEGER, INTENT (IN) :: ncum, nd, na
39	!! INTEGER, INTENT (IN) :: ntra, nloc !jyg: get rid of ntra
40	INTEGER, INTENT (IN) :: nloc
41	INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb, nk
42	REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig
43	REAL, DIMENSION (nloc), INTENT (IN) :: unk, vnk
44	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qta
45	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: ph
46	REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, rs
47	REAL, DIMENSION (nloc, nd), INTENT (IN) :: u, v
48	!! REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: tra ! input of convect3 !jyg: get rid of ntra
49	REAL, DIMENSION (nloc, na), INTENT (IN) :: lv
50	REAL, DIMENSION (nloc, na), INTENT (IN) :: lf
51	REAL, DIMENSION (nloc, na), INTENT (IN) :: frac !ice fraction in condensate
52	REAL, DIMENSION (nloc, na), INTENT (IN) :: h !liquid water static energy of environment
53	REAL, DIMENSION (nloc, na), INTENT (IN) :: hp !liquid water static energy of air shed from adiab. asc.
54	REAL, DIMENSION (nloc, na), INTENT (IN) :: tv, tvp
55	REAL, DIMENSION (nloc, na), INTENT (IN) :: ep, clw
56
57	!outputs:
58	REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: Ment, Qent
59	REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: uent, vent
60	REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: Sigij, elij
61	REAL, DIMENSION (nloc, na), INTENT (OUT) :: supmax ! Highest mixing fraction of mixed
62	! updraughts with the sign of (h-hp)
63	!! REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent !jyg: get rid of ntra
64	REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: Ments, Qents
65	REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: hent
66	INTEGER, DIMENSION (nloc, nd), INTENT (OUT) :: nent
67
68	!local variables:
69	INTEGER i, j, k, il, im, jm
70	INTEGER num1, num2
71	REAL :: rti, bf2, anum, denom, dei, altem, cwat, stemp
72	REAL :: alt, delp, delm
73	REAL, DIMENSION (nloc) :: Qmixmax, Rmixmax, sqmrmax
74	REAL, DIMENSION (nloc) :: Qmixmin, Rmixmin, sqmrmin
75	REAL, DIMENSION (nloc) :: signhpmh
76	REAL, DIMENSION (nloc) :: Sx
77	REAL :: Scrit2
78	REAL, DIMENSION (nloc) :: Smid, Sjmin, Sjmax
79	REAL, DIMENSION (nloc) :: Sbef, sup, smin
80	REAL, DIMENSION (nloc) :: ASij, ASij_inv, smax, Scrit
81	REAL, DIMENSION (nloc, nd, nd) :: Sij
82	REAL, DIMENSION (nloc, nd) :: csum
83	REAL :: awat
84	REAL :: cpm !Mixed draught heat capacity
85	REAL :: Tm !Mixed draught temperature
86	LOGICAL, DIMENSION (nloc) :: lwork
87
88	REAL amxupcrit, df, ff
89	INTEGER nstep
90
91	INTEGER,PARAMETER :: igout=1
92
93	! -- Mixing probability distribution functions
94
95	REAL Qcoef1, Qcoef2, QFF, QFFF, Qmix, Rmix, Qmix1, Rmix1, Qmix2, Rmix2, F
96	REAL :: Qcoef1max,Qcoef2max !ym WARNING
97	!ym redefine local variable instead use module variable
98	!ym to check when refactoring deep convection
99	!ym => eliminate "first" SAVE variable
100	!ym probably all these folowing lines will be removed
101	Qcoef1(F) = tanh(F/gammas)
102	Qcoef2(F) = (tanh(F/gammas)+gammas*log(cosh((1.-F)/gammas)/cosh(F/gammas)))
103	QFF(F) = max(min(F,1.), 0.)
104	QFFf(F) = min(QFF(F), scut)
105	Qmix1(F) = (tanh((QFF(F)-Fmax)/gammas)+Qcoef1max)/Qcoef2max
106	Rmix1(F) = (gammaslog(cosh((QFF(F)-Fmax)/gammas))+QFF(F)Qcoef1max)/Qcoef2max
107	Qmix2(F) = -log(1.-QFFf(F))/scut
108	Rmix2(F) = (QFFf(F)+(1.-QFF(F))*log(1.-QFFf(F)))/scut
109	Qmix(F) = qqa1Qmix1(F) + qqa2Qmix2(F)
110	Rmix(F) = qqa1Rmix1(F) + qqa2Rmix2(F)
111
112
113
114	! =====================================================================
115	! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
116	! =====================================================================
117
118	Qcoef1max = Qcoef1(Fmax)
119	Qcoef2max = Qcoef2(Fmax)
120
121	! ori do 360 i=1,ncum*nlp
122	DO j = 1, nl
123	DO il = 1, ncum
124	nent(il, j) = 0
125	! in convect3, m is computed in cv3_closure
126	! ori m(i,1)=0.0
127	END DO
128	END DO
129
130	! ori do 400 k=1,nlp
131	! ori do 390 j=1,nlp
132	DO j = 1, nl
133	DO k = 1, nl
134	DO il = 1, ncum
135	Qent(il, k, j) = rr(il, j)
136	uent(il, k, j) = u(il, j)
137	vent(il, k, j) = v(il, j)
138	elij(il, k, j) = 0.0
139	hent(il, k, j) = 0.0
140	!AC! Ment(i,k,j)=0.0
141	!AC! Sij(i,k,j)=0.0
142	END DO
143	END DO
144	END DO
145
146	!AC!
147	Ment(1:ncum, 1:nd, 1:nd) = 0.0
148	Sij(1:ncum, 1:nd, 1:nd) = 0.0
149	!AC!
150	!ym
151	Sigij(1:ncum, 1:nd, 1:nd) = 0.0
152	!ym
153
154	! =====================================================================
155	! --- CALCULATE ENTRAINED AIR MASS FLUX (Ment), TOTAL WATER MIXING
156	! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
157	! --- FRACTION (Sij)
158	! =====================================================================
159
160	DO i = minorig + 1, nl
161
162	IF (ok_entrain) THEN
163	DO j = minorig, nl
164	DO il = 1, ncum
165	IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)-1)) &
166	.AND. (j<=inb(il))) THEN
167
168	!! rti = qnk(il) - ep(il, i)*clw(il, i)
169	rti = qta(il,i-1) - ep(il, i)*clw(il, i)
170	bf2 = 1. + lv(il, j)lv(il, j)rs(il, j)/(rrvt(il,j)t(il,j)*cpd)
171	!jyg(from aj)<
172	IF (cvflag_ice) THEN
173	! print*,cvflag_ice,'cvflag_ice dans do 700'
174	IF (t(il,j)<=263.15) THEN
175	bf2 = 1. + (lf(il,j)+lv(il,j))(lv(il,j)+frac(il,j) &
176	lf(il,j))rs(il, j)/(rrvt(il,j)t(il,j)cpd)
177	END IF
178	END IF
179	!>jyg
180	anum = h(il, j) - hp(il, i) + (cpv-cpd)t(il, j)(rti-rr(il,j))
181	denom = h(il, i) - hp(il, i) + (cpd-cpv)(rr(il,i)-rti)t(il, j)
182	dei = denom
183	IF (abs(dei)<0.01) dei = 0.01
184	Sij(il, i, j) = anum/dei
185	Sij(il, i, i) = 1.0
186	altem = Sij(il, i, j)rr(il, i) + (1.-Sij(il,i,j))rti - rs(il, j)
187	altem = altem/bf2
188	cwat = clw(il, j)*(1.-ep(il,j))
189	stemp = Sij(il, i, j)
190	IF ((stemp<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
191	!jyg(from aj)<
192	IF (cvflag_ice) THEN
193	anum = anum - (lv(il,j)+frac(il,j)lf(il,j))(rti-rs(il,j)-cwat*bf2)
194	denom = denom + (lv(il,j)+frac(il,j)lf(il,j))(rr(il,i)-rti)
195	ELSE
196	anum = anum - lv(il, j)(rti-rs(il,j)-cwatbf2)
197	denom = denom + lv(il, j)*(rr(il,i)-rti)
198	END IF
199	!>jyg
200	IF (abs(denom)<0.01) denom = 0.01
201	Sij(il, i, j) = anum/denom
202	altem = Sij(il, i, j)rr(il, i) + (1.-Sij(il,i,j))rti - rs(il, j)
203	altem = altem - (bf2-1.)*cwat
204	END IF
205	IF (Sij(il,i,j)>0.0) THEN
206	!!! Ment(il,i,j)=m(il,i)
207	Ment(il, i, j) = 1.
208	elij(il, i, j) = altem
209	elij(il, i, j) = amax1(0.0, elij(il,i,j))
210	nent(il, i) = nent(il, i) + 1
211	END IF
212
213	Sij(il, i, j) = amax1(0.0, Sij(il,i,j))
214	Sij(il, i, j) = amin1(1.0, Sij(il,i,j))
215	ELSE IF (j > i) THEN
216	IF (prt_level >= 10) THEN
217	print *,'cv3p_mixing i, j, Sij given by the no-precip eq. ', i, j, Sij(il,i,j)
218	ENDIF
219	END IF ! new
220	END DO
221	END DO
222	ELSE ! (ok_entrain)
223	DO il = 1,ncum
224	nent(il,i) = 0
225	ENDDO
226	ENDIF ! (ok_entrain)
227
228	!jygdebug<
229	IF (prt_level >= 10) THEN
230	print *,'cv3p_mixing i, nent(i), icb, inb ',i, nent(igout,i), icb(igout), inb(igout)
231	IF (nent(igout,i) .gt. 0) THEN
232	print *,'i,(j,Sij(i,j),j=icb-1,inb) ',i,(j,Sij(igout,i,j),j=icb(igout)-1,inb(igout))
233	ENDIF
234	ENDIF
235	!>jygdebug
236
237	! * if no air can entrain at level i assume that updraft detrains *
238	! * at that level and calculate detrained air flux and properties *
239
240
241	! @ do 170 i=icb(il),inb(il)
242
243	DO il = 1, ncum
244	IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
245	! @ if(nent(il,i).eq.0)then
246	!!! Ment(il,i,i)=m(il,i)
247	Ment(il, i, i) = 1.
248	!! Qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
249	Qent(il, i, i) = qta(il,i-1) - ep(il, i)*clw(il, i)
250	uent(il, i, i) = unk(il)
251	vent(il, i, i) = vnk(il)
252	IF (fl_cor_ebil .GE. 2) THEN
253	hent(il, i, i) = hp(il,i)
254	ENDIF
255	elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
256	Sij(il, i, i) = 0.0
257	END IF
258	END DO
259	END DO ! i = minorig + 1, nl
260
261	DO j = minorig, nl
262	DO i = minorig, nl
263	DO il = 1, ncum
264	IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
265	(i>=icb(il)) .AND. (i<=inb(il))) THEN
266	Sigij(il, i, j) = Sij(il, i, j)
267	END IF
268	END DO
269	END DO
270	END DO
271	! @ enddo
272
273	! @170 continue
274
275	! =====================================================================
276	! --- NORMALIZE ENTRAINED AIR MASS FLUXES
277	! --- TO REPRESENT EQUAL PROBABILITIES OF MIXING
278	! =====================================================================
279
280	csum(:,:) = 0.
281
282	DO il = 1, ncum
283	lwork(il) = .FALSE.
284	END DO
285
286	! ---------------------------------------------------------------
287	DO i = minorig + 1, nl !Loop on origin level "i"
288	! ---------------------------------------------------------------
289
290	num1 = 0
291	DO il = 1, ncum
292	IF (i>=icb(il) .AND. i<=inb(il)) num1 = num1 + 1
293	END DO
294	!ym IF (num1<=0) GO TO 789
295	IF (num1<=0) CYCLE
296
297
298	!JYG1 Find maximum of SIJ for J>I, if any.
299
300	Sx(:) = 0.
301
302	DO il = 1, ncum
303	IF (i>=icb(il) .AND. i<=inb(il)) THEN
304	signhpmh(il) = sign(1., hp(il,i)-h(il,i))
305	Sbef(il) = max(0., signhpmh(il))
306	END IF
307	END DO
308
309	DO j = i + 1, nl
310	DO il = 1, ncum
311	IF (i>=icb(il) .AND. i<=inb(il) .AND. j<=inb(il)) THEN
312	IF (Sbef(il)<Sij(il,i,j)) THEN
313	Sx(il) = max(Sij(il,i,j), Sx(il))
314	END IF
315	Sbef(il) = Sij(il, i, j)
316	END IF
317	END DO
318	END DO
319
320
321	DO il = 1, ncum
322	IF (i>=icb(il) .AND. i<=inb(il)) THEN
323	lwork(il) = (nent(il,i)/=0)
324	!! rti = qnk(il) - ep(il, i)*clw(il, i)
325	rti = qta(il,i-1) - ep(il, i)*clw(il, i)
326	!jyg<
327	IF (cvflag_ice) THEN
328
329	anum = h(il, i) - hp(il, i) - (lv(il,i)+frac(il,i)lf(il,i)) &
330	(rti-rs(il,i)) + (cpv-cpd)t(il, i)(rti-rr(il,i))
331	denom = h(il, i) - hp(il, i) + (lv(il,i)+frac(il,i)lf(il,i)) &
332	(rr(il,i)-rti) + (cpd-cpv)t(il, i)(rr(il,i)-rti)
333	ELSE
334
335	anum = h(il, i) - hp(il, i) - lv(il, i)*(rti-rs(il,i)) + &
336	(cpv-cpd)t(il, i)(rti-rr(il,i))
337	denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-rti) + &
338	(cpd-cpv)t(il, i)(rr(il,i)-rti)
339	END IF
340	!>jyg
341	IF (abs(denom)<0.01) denom = 0.01
342	Scrit(il) = min(anum/denom, 1.)
343	alt = rti - rs(il, i) + Scrit(il)*(rr(il,i)-rti)
344
345	!JYG1 Find new critical value Scrit2
346	! such that : Sij > Scrit2 => mixed draught will detrain at J<I
347	! Sij < Scrit2 => mixed draught will detrain at J>I
348
349	Scrit2 = min(Scrit(il), Sx(il))*max(0., -signhpmh(il)) + &
350	Scrit(il)*max(0., signhpmh(il))
351
352	Scrit(il) = Scrit2
353
354	!JYG Correction pour la nouvelle logique; la correction pour ALT
355	! est un peu au hazard
356	IF (Scrit(il)<=0.0) Scrit(il) = 0.0
357	IF (alt<=0.0) Scrit(il) = 1.0
358
359	smax(il) = 0.0
360	ASij(il) = 0.0
361	sup(il) = 0. ! upper S-value reached by descending draughts
362	END IF
363	END DO
364
365	! ---------------------------------------------------------------
366	DO j = minorig, nl !Loop on destination level "j"
367	! ---------------------------------------------------------------
368
369	num2 = 0
370	DO il = 1, ncum
371	IF (i>=icb(il) .AND. i<=inb(il) .AND. &
372	j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
373	lwork(il)) num2 = num2 + 1
374	END DO
375	!ym IF (num2<=0) GO TO 175
376	IF (num2<=0) CYCLE
377	! -----------------------------------------------
378	IF (j>i) THEN
379	! -----------------------------------------------
380	DO il = 1, ncum
381	IF (i>=icb(il) .AND. i<=inb(il) .AND. &
382	j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
383	lwork(il)) THEN
384	IF (Sij(il,i,j)>0.0) THEN
385	Smid(il) = min(Sij(il,i,j), Scrit(il))
386	Sjmax(il) = Smid(il)
387	Sjmin(il) = Smid(il)
388	IF (Smid(il)<smin(il) .AND. Sij(il,i,j+1)<Smid(il)) THEN
389	smin(il) = Smid(il)
390	Sjmax(il) = min((Sij(il,i,j+1)+Sij(il,i,j))/2., Sij(il,i,j), Scrit(il))
391	Sjmin(il) = max((Sbef(il)+Sij(il,i,j))/2., Sij(il,i,j))
392	Sjmin(il) = min(Sjmin(il), Scrit(il))
393	Sbef(il) = Sij(il, i, j)
394	END IF
395	END IF
396	END IF
397	END DO
398	! -----------------------------------------------
399	ELSE IF (j==i) THEN
400	! -----------------------------------------------
401	DO il = 1, ncum
402	IF (i>=icb(il) .AND. i<=inb(il) .AND. &
403	j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
404	lwork(il)) THEN
405	IF (Sij(il,i,j)>0.0) THEN
406	Smid(il) = 1.
407	Sjmin(il) = max((Sij(il,i,j-1)+Smid(il))/2., Scrit(il))*max(0., -signhpmh(il)) + &
408	min((Sij(il,i,j+1)+Smid(il))/2., Scrit(il))*max(0., signhpmh(il))
409	Sjmin(il) = max(Sjmin(il), sup(il))
410	Sjmax(il) = 1.
411
412	! - preparation des variables Scrit, Smin et Sbef pour la partie j>i
413	Scrit(il) = min(Sjmin(il), Sjmax(il), Scrit(il))
414
415	smin(il) = 1.
416	Sbef(il) = max(0., signhpmh(il))
417	supmax(il, i) = sign(Scrit(il), -signhpmh(il))
418	END IF
419	END IF
420	END DO
421	! -----------------------------------------------
422	ELSE IF (j<i) THEN
423	! -----------------------------------------------
424	DO il = 1, ncum
425	IF (i>=icb(il) .AND. i<=inb(il) .AND. &
426	j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
427	lwork(il)) THEN
428	IF (Sij(il,i,j)>0.0) THEN
429	Smid(il) = max(Sij(il,i,j), Scrit(il))
430	Sjmax(il) = Smid(il)
431	Sjmin(il) = Smid(il)
432	IF (Smid(il)>smax(il) .AND. Sij(il,i,j+1)>Smid(il)) THEN
433	smax(il) = Smid(il)
434	Sjmax(il) = max((Sij(il,i,j+1)+Sij(il,i,j))/2., Sij(il,i,j))
435	Sjmax(il) = max(Sjmax(il), Scrit(il))
436	Sjmin(il) = min((Sbef(il)+Sij(il,i,j))/2., Sij(il,i,j))
437	Sjmin(il) = max(Sjmin(il), Scrit(il))
438	Sbef(il) = Sij(il, i, j)
439	END IF
440	IF (abs(Sjmin(il)-Sjmax(il))>1.E-10) &
441	sup(il) = max(Sjmin(il), Sjmax(il), sup(il))
442	END IF
443	END IF
444	END DO
445	! -----------------------------------------------
446	END IF
447	! -----------------------------------------------
448
449
450	DO il = 1, ncum
451	IF (i>=icb(il) .AND. i<=inb(il) .AND. &
452	j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
453	lwork(il)) THEN
454	IF (Sij(il,i,j)>0.0) THEN
455	!! rti = qnk(il) - ep(il, i)*clw(il, i)
456	rti = qta(il,i-1) - ep(il, i)*clw(il, i)
457	Qmixmax(il) = Qmix(Sjmax(il))
458	Qmixmin(il) = Qmix(Sjmin(il))
459	Rmixmax(il) = Rmix(Sjmax(il))
460	Rmixmin(il) = Rmix(Sjmin(il))
461	sqmrmax(il) = Sjmax(il)*Qmix(Sjmax(il)) - Rmix(Sjmax(il))
462	sqmrmin(il) = Sjmin(il)*Qmix(Sjmin(il)) - Rmix(Sjmin(il))
463
464	Ment(il, i, j) = abs(Qmixmax(il)-Qmixmin(il))*Ment(il, i, j)
465
466	! Sigij(i,j) is the 'true' mixing fraction of mixture Ment(i,j)
467	IF (abs(Qmixmax(il)-Qmixmin(il))>1.E-10) THEN
468	Sigij(il, i, j) = (sqmrmax(il)-sqmrmin(il))/(Qmixmax(il)-Qmixmin(il))
469	ELSE
470	Sigij(il, i, j) = 0.
471	END IF
472
473	! -- Compute Qent, uent, vent according to the true mixing fraction
474	Qent(il, i, j) = (1.-Sigij(il,i,j))rti + Sigij(il, i, j)rr(il, i)
475	uent(il, i, j) = (1.-Sigij(il,i,j))unk(il) + Sigij(il, i, j)u(il, i)
476	vent(il, i, j) = (1.-Sigij(il,i,j))vnk(il) + Sigij(il, i, j)v(il, i)
477
478	! -- Compute liquid water static energy of mixed draughts
479	! IF (j .GT. i) THEN
480	! awat=elij(il,i,j)-(1.-ep(il,j))*clw(il,j)
481	! awat=amax1(awat,0.0)
482	! ELSE
483	! awat = 0.
484	! ENDIF
485	! Hent(il,i,j) = (1.-Sigij(il,i,j))*HP(il,i)
486	! : + Sigij(il,i,j)*H(il,i)
487	! : + (LV(il,j)+(cpd-cpv)t(il,j))awat
488	!IM 301008 beg
489	hent(il, i, j) = (1.-Sigij(il,i,j))hp(il, i) + Sigij(il, i, j)h(il, i)
490
491	!jyg<
492	! elij(il, i, j) = Qent(il, i, j) - rs(il, j)
493	! elij(il, i, j) = elij(il, i, j) + &
494	! ((h(il,j)-hent(il,i,j))rs(il,j)lv(il,j) / &
495	! ((cpd(1.-Qent(il,i,j))+Qent(il,i,j)cpv)rrvt(il,j)*t(il,j)))
496	! elij(il, i, j) = elij(il, i, j) / &
497	! (1.+lv(il,j)lv(il,j)rs(il,j) / &
498	! ((cpd(1.-Qent(il,i,j))+Qent(il,i,j)cpv)rrvt(il,j)*t(il,j)))
499	!
500	! Computation of condensate amount Elij, taking into account the ice fraction frac
501	! Warning : the same saturation humidity rs is used over both liquid water and ice; this
502	! should be corrected.
503	!
504	! Heat capacity of mixed draught
505	cpm = cpd+Qent(il,i,j)*(cpv-cpd)
506	!
507	IF (cvflag_ice .and. frac(il,j) .gt. 0.) THEN
508	elij(il, i, j) = Qent(il, i, j) - rs(il, j)
509	elij(il, i, j) = elij(il, i, j) + &
510	(h(il,j)-hent(il,i,j)+(cpv-cpd)(Qent(il,i,j)-rr(il,j))t(il,j))* &
511	rs(il,j)lv(il,j) / (cpmrrvt(il,j)t(il,j))
512	elij(il, i, j) = elij(il, i, j) / &
513	(1.+(lv(il,j)+frac(il,j)lf(il,j))lv(il,j)*rs(il,j) / &
514	(cpmrrvt(il,j)*t(il,j)))
515	ELSE
516	elij(il, i, j) = Qent(il, i, j) - rs(il, j)
517	elij(il, i, j) = elij(il, i, j) + &
518	(h(il,j)-hent(il,i,j)+(cpv-cpd)(Qent(il,i,j)-rr(il,j))t(il,j))* &
519	rs(il,j)lv(il,j) / (cpmrrvt(il,j)t(il,j))
520	elij(il, i, j) = elij(il, i, j) / &
521	(1.+lv(il,j)lv(il,j)rs(il,j) / &
522	(cpmrrvt(il,j)*t(il,j)))
523	ENDIF
524	!>jyg
525	elij(il, i, j) = max(elij(il,i,j), 0.)
526
527	elij(il, i, j) = min(elij(il,i,j), Qent(il,i,j))
528
529	IF (j>i) THEN
530	awat = elij(il, i, j) - (1.-ep(il,j))*clw(il, j)
531	awat = amax1(awat, 0.0)
532	ELSE
533	awat = 0.
534	END IF
535
536	! print ,h(il,j)-hent(il,i,j),LV(il,j)rs(il,j)/(cpdrrvt(il,j)*
537	! : t(il,j))
538
539	!jyg<
540	! hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)t(il,j))awat
541	! Mixed draught temperature at level j
542	IF (cvflag_ice .and. frac(il,j) .gt. 0.) THEN
543	Tm = t(il,j) + (Qent(il,i,j)-elij(il,i,j)-rs(il,j))rrvt(il,j)t(il,j)/(lv(il,j)rs(il,j))
544	hent(il, i, j) = hent(il, i, j) + (lv(il,j)+frac(il,j)lf(il,j)+(cpd-cpv)Tm)*awat
545	ELSE
546	Tm = t(il,j) + (Qent(il,i,j)-elij(il,i,j)-rs(il,j))rrvt(il,j)t(il,j)/(lv(il,j)rs(il,j))
547	hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)Tm)awat
548	ENDIF
549	!>jyg
550
551	!IM 301008 end
552
553	! print *,'mix : i,j,hent(il,i,j),Sigij(il,i,j) ',
554	! : i,j,hent(il,i,j),Sigij(il,i,j)
555
556	! -- ASij is the integral of P(F) over the relevant F interval
557	ASij(il) = ASij(il) + abs(Qmixmax(il)*(1.-Sjmax(il))+Rmixmax(il) - &
558	Qmixmin(il)*(1.-Sjmin(il))-Rmixmin(il))
559
560	END IF
561	END IF
562	END DO
563
564	! -- If I=J (detrainement and entrainement at the same level), then only the
565	! -- adiabatic ascent part of the mixture is considered
566	IF (i==j) THEN
567	DO il = 1, ncum
568	IF (i>=icb(il) .AND. i<=inb(il) .AND. &
569	j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
570	lwork(il)) THEN
571	IF (Sij(il,i,j)>0.0) THEN
572	!! rti = qnk(il) - ep(il, i)*clw(il, i)
573	rti = qta(il,i-1) - ep(il, i)*clw(il, i)
574	!!! Ment(il,i,i) = m(il,i)abs(Qmixmax(il)(1.-Sjmax(il))
575	Ment(il, i, i) = abs(Qmixmax(il)*(1.-Sjmax(il))+Rmixmax(il) - &
576	Qmixmin(il)*(1.-Sjmin(il))-Rmixmin(il))
577	Qent(il, i, i) = rti
578	uent(il, i, i) = unk(il)
579	vent(il, i, i) = vnk(il)
580	hent(il, i, i) = hp(il, i)
581	elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
582	Sigij(il, i, i) = 0.
583	END IF
584	END IF
585	END DO
586	END IF !(i==j)
587
588	! ---------------------------------------------------------------
589	END DO !ym label 175 ! End loop on destination level "j"
590	! ---------------------------------------------------------------
591
592	DO il = 1, ncum
593	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
594	ASij(il) = amax1(1.0E-16, ASij(il))
595	!jyg+lluis<
596	!! ASij(il) = 1.0/ASij(il)
597	ASij_inv(il) = 1.0/ASij(il)
598	! IF the F-interval spanned by possible mixtures is less than 0.01, no mixing occurs
599	IF (ASij_inv(il) > 100.) ASij_inv(il) = 0.
600	!>jyg+lluis
601	csum(il, i) = 0.0
602	END IF
603	END DO
604
605	DO j = minorig, nl
606	DO il = 1, ncum
607	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
608	j>=(icb(il)-1) .AND. j<=inb(il)) THEN
609	!jyg Ment(il, i, j) = Ment(il, i, j)*ASij(il)
610	Ment(il, i, j) = Ment(il, i, j)*ASij_inv(il)
611	END IF
612	END DO
613	END DO
614
615	DO j = minorig, nl
616	DO il = 1, ncum
617	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
618	j>=(icb(il)-1) .AND. j<=inb(il)) THEN
619	csum(il, i) = csum(il, i) + Ment(il, i, j)
620	END IF
621	END DO
622	END DO
623
624	DO il = 1, ncum
625	IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
626	! cc : .and. csum(il,i).lt.m(il,i) ) then
627	nent(il, i) = 0
628	! cc Ment(il,i,i)=m(il,i)
629	Ment(il, i, i) = 1.
630	!! Qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
631	Qent(il, i, i) = qta(il,i-1) - ep(il, i)*clw(il, i)
632	uent(il, i, i) = unk(il)
633	vent(il, i, i) = vnk(il)
634	elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
635	IF (fl_cor_ebil .GE. 2) THEN
636	hent(il, i, i) = hp(il,i)
637	Sigij(il, i, i) = 0.0
638	ELSE
639	Sij(il, i, i) = 0.0
640	ENDIF
641	END IF
642	END DO ! il
643
644	! ---------------------------------------------------------------
645	END DO !ym label 789 ! End loop on origin level "i"
646
647	! ---------------------------------------------------------------
648
649
650	RETURN
651	END SUBROUTINE cv3p_mixing
652
653	END MODULE cv3p_mixing_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format