LMDZ
cv3p_mixing.F90
Go to the documentation of this file.
1 SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, &
2  ph, t, rr, rs, u, v, tra, h, lv, qnk, &
3  unk, vnk, hp, tv, tvp, ep, clw, sig, &
4  ment, qent, hent, uent, vent, nent, &
5  sigij, elij, supmax, ments, qents, traent)
6 ! **************************************************************
7 ! *
8 ! CV3P_MIXING : compute mixed draught properties and, *
9 ! within a scaling factor, mixed draught *
10 ! mass fluxes. *
11 ! written by : VTJ Philips,JY Grandpeix, 21/05/2003, 09.14.15*
12 ! modified by : *
13 ! **************************************************************
14 
15  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
16 
17  IMPLICIT NONE
18 
19  include "cvthermo.h"
20  include "cv3param.h"
21  include "YOMCST2.h"
22 
23 !inputs:
24  INTEGER, INTENT (IN) :: ncum, nd, na
25  INTEGER, INTENT (IN) :: ntra, nloc
26  INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb, nk
27  REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig
28  REAL, DIMENSION (nloc), INTENT (IN) :: qnk, unk, vnk
29  REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: ph
30  REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, rs
31  REAL, DIMENSION (nloc, nd), INTENT (IN) :: u, v
32  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: tra ! input of convect3
33  REAL, DIMENSION (nloc, na), INTENT (IN) :: lv
34  REAL, DIMENSION (nloc, na), INTENT (IN) :: h !liquid water static energy of environment
35  REAL, DIMENSION (nloc, na), INTENT (IN) :: hp !liquid water static energy of air shed from adiab. asc.
36  REAL, DIMENSION (nloc, na), INTENT (IN) :: tv, tvp
37  REAL, DIMENSION (nloc, na), INTENT (IN) :: ep, clw
38 
39 !outputs:
40  REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: Ment, Qent
41  REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: uent, vent
42  REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: Sigij, elij
43  REAL, DIMENSION (nloc, na), INTENT (OUT) :: supmax ! Highest mixing fraction of mixed
44  ! updraughts with the sign of (h-hp)
45  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent
46  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: Ments, Qents
47  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: hent
48  INTEGER, DIMENSION (nloc, nd), INTENT (OUT) :: nent
49 
50 !local variables:
51  INTEGER i, j, k, il, im, jm
52  INTEGER num1, num2
53  REAL :: rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
54  REAL :: alt, delp, delm
55  REAL, DIMENSION (nloc) :: Qmixmax, Rmixmax, sqmrmax
56  REAL, DIMENSION (nloc) :: Qmixmin, Rmixmin, sqmrmin
57  REAL, DIMENSION (nloc) :: signhpmh
58  REAL, DIMENSION (nloc) :: Sx
59  REAL :: Scrit2
60  REAL, DIMENSION (nloc) :: Smid, Sjmin, Sjmax
61  REAL, DIMENSION (nloc) :: Sbef, sup, smin
62 !jyg REAL, DIMENSION (nloc) :: ASij, smax, Scrit
63  REAL, DIMENSION (nloc) :: ASij, ASij_inv, smax, Scrit
64  REAL, DIMENSION (nloc, nd, nd) :: Sij
65  REAL, DIMENSION (nloc, nd) :: csum
66  REAL :: awat
67  LOGICAL, DIMENSION (nloc) :: lwork
68 
69  REAL amxupcrit, df, ff
70  INTEGER nstep
71 
72  INTEGER,SAVE :: igout=1
73 !$OMP THREADPRIVATE(igout)
74 
75 ! -- Mixing probability distribution functions
76 
77  REAL Qcoef1, Qcoef2, QFF, QFFF, Qmix, Rmix, Qmix1, Rmix1, Qmix2, Rmix2, F
78 
79  qcoef1(f) = tanh(f/gammas)
80  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
81  qff(f) = max(min(f,1.), 0.)
82  qfff(f) = min(qff(f), scut)
83  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
84  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/qcoef2max
85  qmix2(f) = -log(1.-qfff(f))/scut
86  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
87  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
88  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
89 
90  INTEGER, SAVE :: ifrst
91  DATA ifrst/0/
92 !$OMP THREADPRIVATE(ifrst)
93 
94 
95 ! =====================================================================
96 ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
97 ! =====================================================================
98 
99 ! -- Initialize mixing PDF coefficients
100  IF (ifrst==0) THEN
101  ifrst = 1
102  qcoef1max = qcoef1(fmax)
103  qcoef2max = qcoef2(fmax)
104 
105  print*, 'fmax, gammas, qqa1, qqa2, Qcoef1max, Qcoef2max ', &
106  fmax, gammas, qqa1, qqa2, qcoef1max, qcoef2max
108 
109  END IF
110 
111 
112 ! ori do 360 i=1,ncum*nlp
113  DO j = 1, nl
114  DO i = 1, ncum
115  nent(i, j) = 0
116 ! in convect3, m is computed in cv3_closure
117 ! ori m(i,1)=0.0
118  END DO
119  END DO
120 
121 ! ori do 400 k=1,nlp
122 ! ori do 390 j=1,nlp
123  DO j = 1, nl
124  DO k = 1, nl
125  DO i = 1, ncum
126  qent(i, k, j) = rr(i, j)
127  uent(i, k, j) = u(i, j)
128  vent(i, k, j) = v(i, j)
129  elij(i, k, j) = 0.0
130  hent(i, k, j) = 0.0
131 !AC! Ment(i,k,j)=0.0
132 !AC! Sij(i,k,j)=0.0
133  END DO
134  END DO
135  END DO
136 
137 !AC!
138  ment(1:ncum, 1:nd, 1:nd) = 0.0
139  sij(1:ncum, 1:nd, 1:nd) = 0.0
140 !AC!
141 
142 !jyg! DO k = 1, ntra
143 !jyg! DO j = 1, nd ! instead nlp
144 !jyg! DO i = 1, nd ! instead nlp
145 !jyg! DO il = 1, ncum
146 !jyg! traent(il, i, j, k) = tra(il, j, k)
147 !jyg! END DO
148 !jyg! END DO
149 !jyg! END DO
150 !jyg! END DO
151 
152 ! =====================================================================
153 ! --- CALCULATE ENTRAINED AIR MASS FLUX (Ment), TOTAL WATER MIXING
154 ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
155 ! --- FRACTION (Sij)
156 ! =====================================================================
157 
158  DO i = minorig + 1, nl
159 
160  DO j = minorig, nl
161  DO il = 1, ncum
162  IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)-1)) &
163  .AND. (j<=inb(il))) THEN
164 
165  rti = qnk(il) - ep(il, i)*clw(il, i)
166  bf2 = 1. + lv(il, j)*lv(il, j)*rs(il, j)/(rrv*t(il,j)*t(il,j)*cpd)
167  anum = h(il, j) - hp(il, i) + (cpv-cpd)*t(il, j)*(rti-rr(il,j))
168  denom = h(il, i) - hp(il, i) + (cpd-cpv)*(rr(il,i)-rti)*t(il, j)
169  dei = denom
170  IF (abs(dei)<0.01) dei = 0.01
171  sij(il, i, j) = anum/dei
172  sij(il, i, i) = 1.0
173  altem = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti - rs(il, j)
174  altem = altem/bf2
175  cwat = clw(il, j)*(1.-ep(il,j))
176  stemp = sij(il, i, j)
177  IF ((stemp<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
178  anum = anum - lv(il, j)*(rti-rs(il,j)-cwat*bf2)
179  denom = denom + lv(il, j)*(rr(il,i)-rti)
180  IF (abs(denom)<0.01) denom = 0.01
181  sij(il, i, j) = anum/denom
182  altem = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti - rs(il, j)
183  altem = altem - (bf2-1.)*cwat
184  END IF
185  IF (sij(il,i,j)>0.0) THEN
186 !!! Ment(il,i,j)=m(il,i)
187  ment(il, i, j) = 1.
188  elij(il, i, j) = altem
189  elij(il, i, j) = amax1(0.0, elij(il,i,j))
190  nent(il, i) = nent(il, i) + 1
191  END IF
192 
193  sij(il, i, j) = amax1(0.0, sij(il,i,j))
194  sij(il, i, j) = amin1(1.0, sij(il,i,j))
195  END IF ! new
196  END DO
197  END DO
198 
199 !jygdebug<
200  IF (prt_level >= 10) THEN
201  print *,'cv3p_mixing i, nent(i), icb, inb ',i, nent(igout,i), icb(igout), inb(igout)
202  IF (nent(igout,i) .gt. 0) THEN
203  print *,'i,(j,Sij(i,j),j=icb-1,inb) ',i,(j,sij(igout,i,j),j=icb(igout)-1,inb(igout))
204  ENDIF
205  ENDIF
207 
208 ! *** if no air can entrain at level i assume that updraft detrains ***
209 ! *** at that level and calculate detrained air flux and properties ***
210 
211 
212 ! @ do 170 i=icb(il),inb(il)
213 
214  DO il = 1, ncum
215  IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
216 ! @ if(nent(il,i).eq.0)then
217 !!! Ment(il,i,i)=m(il,i)
218  ment(il, i, i) = 1.
219  qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
220  uent(il, i, i) = unk(il)
221  vent(il, i, i) = vnk(il)
222  elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
223  sij(il, i, i) = 0.0
224  END IF
225  END DO
226  END DO
227 
228 !jyg! DO j = 1, ntra
229 !jyg! DO i = minorig + 1, nl
230 !jyg! DO il = 1, ncum
231 !jyg! IF (i>=icb(il) .AND. i<=inb(il) .AND. nent(il,i)==0) THEN
232 !jyg! traent(il, i, i, j) = tra(il, nk(il), j)
233 !jyg! END IF
234 !jyg! END DO
235 !jyg! END DO
236 !jyg! END DO
237 
238  DO j = minorig, nl
239  DO i = minorig, nl
240  DO il = 1, ncum
241  IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
242  (i>=icb(il)) .AND. (i<=inb(il))) THEN
243  sigij(il, i, j) = sij(il, i, j)
244  END IF
245  END DO
246  END DO
247  END DO
248 ! @ enddo
249 
250 ! @170 continue
251 
252 ! =====================================================================
253 ! --- NORMALIZE ENTRAINED AIR MASS FLUXES
254 ! --- TO REPRESENT EQUAL PROBABILITIES OF MIXING
255 ! =====================================================================
256 
257  CALL zilch(csum, nloc*nd)
258 
259  DO il = 1, ncum
260  lwork(il) = .false.
261  END DO
262 
263 ! ---------------------------------------------------------------
264  DO i = minorig + 1, nl !Loop on origin level "i"
265 ! ---------------------------------------------------------------
266 
267  num1 = 0
268  DO il = 1, ncum
269  IF (i>=icb(il) .AND. i<=inb(il)) num1 = num1 + 1
270  END DO
271  IF (num1<=0) GO TO 789
272 
273 
274 !JYG1 Find maximum of SIJ for J>I, if any.
275 
276  sx(:) = 0.
277 
278  DO il = 1, ncum
279  IF (i>=icb(il) .AND. i<=inb(il)) THEN
280  signhpmh(il) = sign(1., hp(il,i)-h(il,i))
281  sbef(il) = max(0., signhpmh(il))
282  END IF
283  END DO
284 
285  DO j = i + 1, nl
286  DO il = 1, ncum
287  IF (i>=icb(il) .AND. i<=inb(il) .AND. j<=inb(il)) THEN
288  IF (sbef(il)<sij(il,i,j)) THEN
289  sx(il) = max(sij(il,i,j), sx(il))
290  END IF
291  sbef(il) = sij(il, i, j)
292  END IF
293  END DO
294  END DO
295 
296 
297  DO il = 1, ncum
298  IF (i>=icb(il) .AND. i<=inb(il)) THEN
299  lwork(il) = (nent(il,i)/=0)
300  rti = qnk(il) - ep(il, i)*clw(il, i)
301  anum = h(il, i) - hp(il, i) - lv(il, i)*(rti-rs(il,i)) + &
302  (cpv-cpd)*t(il, i)*(rti-rr(il,i))
303  denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-rti) + &
304  (cpd-cpv)*t(il, i)*(rr(il,i)-rti)
305  IF (abs(denom)<0.01) denom = 0.01
306  scrit(il) = min(anum/denom, 1.)
307  alt = rti - rs(il, i) + scrit(il)*(rr(il,i)-rti)
308 
309 !JYG1 Find new critical value Scrit2
310 ! such that : Sij > Scrit2 => mixed draught will detrain at J<I
311 ! Sij < Scrit2 => mixed draught will detrain at J>I
312 
313  scrit2 = min(scrit(il), sx(il))*max(0., -signhpmh(il)) + &
314  scrit(il)*max(0., signhpmh(il))
315 
316  scrit(il) = scrit2
317 
318 !JYG Correction pour la nouvelle logique; la correction pour ALT
319 ! est un peu au hazard
320  IF (scrit(il)<=0.0) scrit(il) = 0.0
321  IF (alt<=0.0) scrit(il) = 1.0
322 
323  smax(il) = 0.0
324  asij(il) = 0.0
325  sup(il) = 0. ! upper S-value reached by descending draughts
326  END IF
327  END DO
328 
329 ! ---------------------------------------------------------------
330  DO j = minorig, nl !Loop on destination level "j"
331 ! ---------------------------------------------------------------
332 
333  num2 = 0
334  DO il = 1, ncum
335  IF (i>=icb(il) .AND. i<=inb(il) .AND. &
336  j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
337  lwork(il)) num2 = num2 + 1
338  END DO
339  IF (num2<=0) GO TO 175
340 
341 ! -----------------------------------------------
342  IF (j>i) THEN
343 ! -----------------------------------------------
344  DO il = 1, ncum
345  IF (i>=icb(il) .AND. i<=inb(il) .AND. &
346  j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
347  lwork(il)) THEN
348  IF (sij(il,i,j)>0.0) THEN
349  smid(il) = min(sij(il,i,j), scrit(il))
350  sjmax(il) = smid(il)
351  sjmin(il) = smid(il)
352  IF (smid(il)<smin(il) .AND. sij(il,i,j+1)<smid(il)) THEN
353  smin(il) = smid(il)
354  sjmax(il) = min((sij(il,i,j+1)+sij(il,i,j))/2., sij(il,i,j), scrit(il))
355  sjmin(il) = max((sbef(il)+sij(il,i,j))/2., sij(il,i,j))
356  sjmin(il) = min(sjmin(il), scrit(il))
357  sbef(il) = sij(il, i, j)
358  END IF
359  END IF
360  END IF
361  END DO
362 ! -----------------------------------------------
363  ELSE IF (j==i) THEN
364 ! -----------------------------------------------
365  DO il = 1, ncum
366  IF (i>=icb(il) .AND. i<=inb(il) .AND. &
367  j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
368  lwork(il)) THEN
369  IF (sij(il,i,j)>0.0) THEN
370  smid(il) = 1.
371  sjmin(il) = max((sij(il,i,j-1)+smid(il))/2., scrit(il))*max(0., -signhpmh(il)) + &
372  min((sij(il,i,j+1)+smid(il))/2., scrit(il))*max(0., signhpmh(il))
373  sjmin(il) = max(sjmin(il), sup(il))
374  sjmax(il) = 1.
375 
376 ! - preparation des variables Scrit, Smin et Sbef pour la partie j>i
377  scrit(il) = min(sjmin(il), sjmax(il), scrit(il))
378 
379  smin(il) = 1.
380  sbef(il) = max(0., signhpmh(il))
381  supmax(il, i) = sign(scrit(il), -signhpmh(il))
382  END IF
383  END IF
384  END DO
385 ! -----------------------------------------------
386  ELSE IF (j<i) THEN
387 ! -----------------------------------------------
388  DO il = 1, ncum
389  IF (i>=icb(il) .AND. i<=inb(il) .AND. &
390  j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
391  lwork(il)) THEN
392  IF (sij(il,i,j)>0.0) THEN
393  smid(il) = max(sij(il,i,j), scrit(il))
394  sjmax(il) = smid(il)
395  sjmin(il) = smid(il)
396  IF (smid(il)>smax(il) .AND. sij(il,i,j+1)>smid(il)) THEN
397  smax(il) = smid(il)
398  sjmax(il) = max((sij(il,i,j+1)+sij(il,i,j))/2., sij(il,i,j))
399  sjmax(il) = max(sjmax(il), scrit(il))
400  sjmin(il) = min((sbef(il)+sij(il,i,j))/2., sij(il,i,j))
401  sjmin(il) = max(sjmin(il), scrit(il))
402  sbef(il) = sij(il, i, j)
403  END IF
404  IF (abs(sjmin(il)-sjmax(il))>1.e-10) &
405  sup(il) = max(sjmin(il), sjmax(il), sup(il))
406  END IF
407  END IF
408  END DO
409 ! -----------------------------------------------
410  END IF
411 ! -----------------------------------------------
412 
413 
414  DO il = 1, ncum
415  IF (i>=icb(il) .AND. i<=inb(il) .AND. &
416  j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
417  lwork(il)) THEN
418  IF (sij(il,i,j)>0.0) THEN
419  rti = qnk(il) - ep(il, i)*clw(il, i)
420  qmixmax(il) = qmix(sjmax(il))
421  qmixmin(il) = qmix(sjmin(il))
422  rmixmax(il) = rmix(sjmax(il))
423  rmixmin(il) = rmix(sjmin(il))
424  sqmrmax(il) = sjmax(il)*qmix(sjmax(il)) - rmix(sjmax(il))
425  sqmrmin(il) = sjmin(il)*qmix(sjmin(il)) - rmix(sjmin(il))
426 
427  ment(il, i, j) = abs(qmixmax(il)-qmixmin(il))*ment(il, i, j)
428 
429 ! Sigij(i,j) is the 'true' mixing fraction of mixture Ment(i,j)
430  IF (abs(qmixmax(il)-qmixmin(il))>1.e-10) THEN
431  sigij(il, i, j) = (sqmrmax(il)-sqmrmin(il))/(qmixmax(il)-qmixmin(il))
432  ELSE
433  sigij(il, i, j) = 0.
434  END IF
435 
436 ! -- Compute Qent, uent, vent according to the true mixing fraction
437  qent(il, i, j) = (1.-sigij(il,i,j))*rti + sigij(il, i, j)*rr(il, i)
438  uent(il, i, j) = (1.-sigij(il,i,j))*unk(il) + sigij(il, i, j)*u(il, i)
439  vent(il, i, j) = (1.-sigij(il,i,j))*vnk(il) + sigij(il, i, j)*v(il, i)
440 
441 ! -- Compute liquid water static energy of mixed draughts
442 ! IF (j .GT. i) THEN
443 ! awat=elij(il,i,j)-(1.-ep(il,j))*clw(il,j)
444 ! awat=amax1(awat,0.0)
445 ! ELSE
446 ! awat = 0.
447 ! ENDIF
448 ! Hent(il,i,j) = (1.-Sigij(il,i,j))*HP(il,i)
449 ! : + Sigij(il,i,j)*H(il,i)
450 ! : + (LV(il,j)+(cpd-cpv)*t(il,j))*awat
451 !IM 301008 beg
452  hent(il, i, j) = (1.-sigij(il,i,j))*hp(il, i) + sigij(il, i, j)*h(il, i)
453 
454  elij(il, i, j) = qent(il, i, j) - rs(il, j)
455  elij(il, i, j) = elij(il, i, j) + &
456  ((h(il,j)-hent(il,i,j))*rs(il,j)*lv(il,j) / &
457  ((cpd*(1.-qent(il,i,j))+qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
458  elij(il, i, j) = elij(il, i, j) / &
459  (1.+lv(il,j)*lv(il,j)*rs(il,j) / &
460  ((cpd*(1.-qent(il,i,j))+qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
461 
462  elij(il, i, j) = max(elij(il,i,j), 0.)
463 
464  elij(il, i, j) = min(elij(il,i,j), qent(il,i,j))
465 
466  IF (j>i) THEN
467  awat = elij(il, i, j) - (1.-ep(il,j))*clw(il, j)
468  awat = amax1(awat, 0.0)
469  ELSE
470  awat = 0.
471  END IF
472 
473 ! print *,h(il,j)-hent(il,i,j),LV(il,j)*rs(il,j)/(cpd*rrv*t(il,j)*
474 ! : t(il,j))
475 
476  hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))*awat
477 !IM 301008 end
478 
479 ! print *,'mix : i,j,hent(il,i,j),Sigij(il,i,j) ',
480 ! : i,j,hent(il,i,j),Sigij(il,i,j)
481 
482 ! -- ASij is the integral of P(F) over the relevant F interval
483  asij(il) = asij(il) + abs(qmixmax(il)*(1.-sjmax(il))+rmixmax(il) - &
484  qmixmin(il)*(1.-sjmin(il))-rmixmin(il))
485 
486  END IF
487  END IF
488  END DO
489 !jyg! DO k = 1, ntra
490 !jyg! DO il = 1, ncum
491 !jyg! IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
492 !jyg! (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
493 !jyg! lwork(il)) THEN
494 !jyg! IF (Sij(il,i,j)>0.0) THEN
495 !jyg! traent(il, i, j, k) = Sigij(il, i, j)*tra(il, i, k) + &
496 !jyg! (1.-Sigij(il,i,j))*tra(il, nk(il), k)
497 !jyg! END IF
498 !jyg! END IF
499 !jyg! END DO
500 !jyg! END DO
501 
502 ! -- If I=J (detrainement and entrainement at the same level), then only the
503 ! -- adiabatic ascent part of the mixture is considered
504  IF (i==j) THEN
505  DO il = 1, ncum
506  IF (i>=icb(il) .AND. i<=inb(il) .AND. &
507  j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
508  lwork(il)) THEN
509  IF (sij(il,i,j)>0.0) THEN
510  rti = qnk(il) - ep(il, i)*clw(il, i)
511 !!! Ment(il,i,i) = m(il,i)*abs(Qmixmax(il)*(1.-Sjmax(il))
512  ment(il, i, i) = abs(qmixmax(il)*(1.-sjmax(il))+rmixmax(il) - &
513  qmixmin(il)*(1.-sjmin(il))-rmixmin(il))
514  qent(il, i, i) = rti
515  uent(il, i, i) = unk(il)
516  vent(il, i, i) = vnk(il)
517  hent(il, i, i) = hp(il, i)
518  elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
519  sigij(il, i, i) = 0.
520  END IF
521  END IF
522  END DO
523 !jyg! DO k = 1, ntra
524 !jyg! DO il = 1, ncum
525 !jyg! IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
526 !jyg! (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
527 !jyg! lwork(il)) THEN
528 !jyg! IF (Sij(il,i,j)>0.0) THEN
529 !jyg! traent(il, i, i, k) = tra(il, nk(il), k)
530 !jyg! END IF
531 !jyg! END IF
532 !jyg! END DO
533 !jyg! END DO
534 
535  END IF
536 
537 ! ---------------------------------------------------------------
538 175 END DO ! End loop on destination level "j"
539 ! ---------------------------------------------------------------
540 
541  DO il = 1, ncum
542  IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
543  asij(il) = amax1(1.0e-16, asij(il))
544 !jyg+lluis<
545 !! ASij(il) = 1.0/ASij(il)
546  asij_inv(il) = 1.0/asij(il)
547 ! IF the F-interval spanned by possible mixtures is less than 0.01, no mixing occurs
548  IF (asij_inv(il) > 100.) asij_inv(il) = 0.
550  csum(il, i) = 0.0
551  END IF
552  END DO
553 
554  DO j = minorig, nl
555  DO il = 1, ncum
556  IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
557  j>=(icb(il)-1) .AND. j<=inb(il)) THEN
558 !jyg Ment(il, i, j) = Ment(il, i, j)*ASij(il)
559  ment(il, i, j) = ment(il, i, j)*asij_inv(il)
560  END IF
561  END DO
562  END DO
563 
564  DO j = minorig, nl
565  DO il = 1, ncum
566  IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
567  j>=(icb(il)-1) .AND. j<=inb(il)) THEN
568  csum(il, i) = csum(il, i) + ment(il, i, j)
569  END IF
570  END DO
571  END DO
572 
573  DO il = 1, ncum
574  IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
575 ! cc : .and. csum(il,i).lt.m(il,i) ) then
576  nent(il, i) = 0
577 ! cc Ment(il,i,i)=m(il,i)
578  ment(il, i, i) = 1.
579  qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
580  uent(il, i, i) = unk(il)
581  vent(il, i, i) = vnk(il)
582  elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
583  sij(il, i, i) = 0.0
584  END IF
585  END DO ! il
586 
587 !jyg! DO j = 1, ntra
588 !jyg! DO il = 1, ncum
589 !jyg! IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
590 !jyg!! cc : .and. csum(il,i).lt.m(il,i) ) then
591 !jyg! traent(il, i, i, j) = tra(il, nk(il), j)
592 !jyg! END IF
593 !jyg! END DO
594 !jyg! END DO
595 
596 ! ---------------------------------------------------------------
597 789 END DO ! End loop on origin level "i"
598 ! ---------------------------------------------------------------
599 
600 
601  RETURN
602 END SUBROUTINE cv3p_mixing
603 
cpv
!$Id!Thermodynamical constants for cpv
Definition: cvthermo.h:6
minorig
!$Id!Parameters for minorig
Definition: cv30param.h:5
scut
INTEGER iflag_mix REAL scut REAL Supcrit2 REAL coef_clos_ls!COMMON YOMCST2 scut
Definition: YOMCST2.h:2
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
nl
!$Id!Parameters for nl
Definition: cv30param.h:5
prt_level
!FH On elimine toutes les clefs physiques dans la dynamique prt_level
Definition: write_paramLMDZ_dyn.h:9
u
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm u(l)
cv3p_mixing
subroutine cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, ph, t, rr, rs, u, v, tra, h, lv, qnk, unk, vnk, hp, tv, tvp, ep, clw, sig, Ment, Qent, hent, uent, vent, nent, Sigij, elij, supmax, Ments, Qents, traent)
Definition: cv3p_mixing.F90:6
print_control_mod
Definition: print_control_mod.F90:2
cpd
!$Id!Thermodynamical constants for t0 real clmci real epsim1 real hrd real grav COMMON cvthermo cpd
Definition: cvthermo.h:6
rrv
!$Id!Thermodynamical constants for rrv
Definition: cvthermo.h:6
qqa1
INTEGER iflag_mix REAL qqa1
Definition: YOMCST2.h:2
gammas
INTEGER iflag_mix REAL gammas
Definition: YOMCST2.h:2
qqa2
INTEGER iflag_mix REAL qqa2
Definition: YOMCST2.h:2
rr
real rr
Definition: comcstphy.h:1
print_control_mod::debug
logical, save debug
Definition: print_control_mod.F90:6
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
zilch
subroutine zilch(x, m)
Definition: zilch.F90:5