source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/concvl.F90 @ 3946

Last change on this file since 3946 was 3331, checked in by acozic, 7 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 26.1 KB
Line 
1SUBROUTINE concvl(iflag_clos, &
2                  dtime, paprs, pplay, k_upper_cv, &
3                  t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
4                  Ale, Alp, sig1, w01, &
5                  d_t, d_q, d_u, d_v, d_tra, &
6                  rain, snow, kbas, ktop, sigd, &
7                  cbmf, plcl, plfc, wbeff, upwd, dnwd, dnwdbis, &
8                  Ma, mip, Vprecip, &
9                  cape, cin, tvp, Tconv, iflag, &
10                  pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
11                  qcondc, wd, pmflxr, pmflxs, &
12!RomP >>>
13!!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
14                  da, phi, mp, phi2, d1a, dam, sij, clw, elij, &     ! RomP
15                  dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
16                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
17                  wdtrainA, wdtrainM, wght, qtc, sigt, &
18                  tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
19!RomP <<<
20                  epmax_diag & ! epmax_cape
21#ifdef ISO
22     &       ,xt,xt_wake,d_xt,xtrain,xtsnow,dd_xt &
23     &       ,xtVprecip,xtVprecipi   &
24#ifdef DIAGISO
25     &       , qlp,xtlp,qvp,xtvp,xtevap,xtclw & ! juste diagnostique 
26     &       , wdtrain,xtwdtrain,tadiab &
27     &       , taux_cond_conv    &
28     &       , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
29     &       , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
30     &       , fxt_evapprecip,Mi,Amp_diag,tcond &
31     &       , f_detrainement,q_detrainement,xt_detrainement &
32#endif         
33#endif
34     &        ) ! **************************************************************
35! *
36! CONCVL                                                      *
37! *
38! *
39! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
40! modified by :                                               *
41! **************************************************************
42
43
44  USE dimphy
45#ifdef ISO
46  USE infotrac_phy, ONLY: nbtr,ntraciso
47  USE isotopes_mod, ONLY: iso_eau, bidouille_anti_divergence, ridicule, &
48        iso_eau,iso_HDO     
49#else
50  USE infotrac_phy, ONLY: nbtr
51#endif
52#ifdef ISOVERIF
53      USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
54        iso_verif_egalite_choix,iso_verif_aberrant,iso_verif_egalite, &
55        iso_verif_noNaN
56#endif
57#ifdef ISOTRAC
58      USE isotrac_routines_mod, only: iso_verif_traceur_jbid_vect
59#ifdef ISOVERIF
60      USE isotopes_verif_mod, ONLY: iso_verif_traceur_vect, &
61&       iso_verif_trac_masse_vect, iso_verif_traceur,  &
62&       iso_verif_traceur_justmass
63#endif
64#endif
65  USE phys_local_var_mod, ONLY: omega
66  USE print_control_mod, ONLY: prt_level, lunout
67  IMPLICIT NONE
68! ======================================================================
69! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
70! Objet: schema de convection de Emanuel (1991) interface
71! ======================================================================
72! Arguments:
73! dtime--input-R-pas d'integration (s)
74! s-------input-R-la vAleur "s" pour chaque couche
75! sigs----input-R-la vAleur "sigma" de chaque couche
76! sig-----input-R-la vAleur de "sigma" pour chaque niveau
77! psolpa--input-R-la pression au sol (en Pa)
78! pskapa--input-R-exponentiel kappa de psolpa
79! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)
80! q-------input-R-vapeur d'eau (en kg/kg)
81
82! work*: input et output: deux variables de travail,
83! on peut les mettre a 0 au debut
84! ALE--------input-R-energie disponible pour soulevement
85! ALP--------input-R-puissance disponible pour soulevement
86
87! d_h--------output-R-increment de l'enthAlpie potentielle (h)
88! d_q--------output-R-increment de la vapeur d'eau
89! rain-------output-R-la pluie (mm/s)
90! snow-------output-R-la neige (mm/s)
91! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
92! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
93! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
94! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
95! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
96! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)
97! Tconv------output-R-environment temperature seen by convective scheme (K)
98! Cape-------output-R-CAPE (J/kg)
99! Cin -------output-R-CIN  (J/kg)
100! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
101! adiabatiquement a partir du niveau 1 (K)
102! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
103! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
104! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
105! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
106! lalim_conv-
107! wght_th----
108! evap-------output-R
109! ep---------output-R
110! epmlmMm----output-R
111! eplaMm-----output-R
112! wdtrainA---output-R
113! wdtrainM---output-R
114! wght-------output-R
115! ======================================================================
116
117
118  include "clesphys.h"
119
120  INTEGER iflag_clos
121
122  REAL dtime, paprs(klon, klev+1), pplay(klon, klev)
123  INTEGER k_upper_cv
124  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
125  REAL t_wake(klon, klev), q_wake(klon, klev)
126  REAL s_wake(klon)
127  REAL tra(klon, klev, nbtr)
128  INTEGER ntra
129  REAL sig1(klon, klev), w01(klon, klev), ptop2(klon)
130  REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
131  REAL Ale(klon), Alp(klon)
132
133  REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev)
134  REAL dd_t(klon, klev), dd_q(klon, klev)
135  REAL d_tra(klon, klev, nbtr)
136  REAL rain(klon), snow(klon)
137
138  INTEGER kbas(klon), ktop(klon)
139  REAL em_ph(klon, klev+1), em_p(klon, klev)
140  REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
141
142#ifdef ISO
143       REAL xt(ntraciso,klon,klev)
144       REAL xtl(ntraciso,klon,klev)
145       REAL xt_undi(ntraciso,klon,klev)
146       REAL d_xt(ntraciso,klon,klev)
147       real dd_xt(ntraciso,klon,klev)
148       REAL xtrain(ntraciso,klon)
149       real xtsnow(ntraciso,klon)
150       real fxtd(ntraciso,klon)
151       REAL xt1(ntraciso,klon,klev)
152       integer ixt
153       ! juste diagnostique
154#ifdef DIAGISO
155       real qlp(klon,klev),xtlp(niso,klon,klev), &
156     &        qvp(klon,klev),xtvp(ntraciso,klon,klev), &
157     &        xtevap(niso,klon,klev), &
158     &        xtclw(ntraciso,klon,klev), &
159     &        wdtrain(klon,klev),xtwdtrain(niso,klon,klev), &
160     &        tadiab(klon,klev), taux_cond_conv(klon,klev), &
161     &        fq_detrainement(klon,klev),fq_ddft(klon,klev), &
162     &        fq_fluxmasse(klon,klev),fq_evapprecip(klon,klev), &
163     &        fxt_detrainement(niso,klon,klev),fxt_ddft(niso,klon,klev), &
164     &        fxt_fluxmasse(niso,klon,klev), &
165     &        fxt_evapprecip(niso,klon,klev), Mi(klon,klev), &
166     &        Amp_diag(klon,klev),tcond(klon,klev) &
167!     :        ,mentbas(klon,klev), qentbas(klon,klev),
168!     :        xtentbas(niso,klon,klev)   
169       real f_detrainement(klon,klev),q_detrainement(klon,klev), &
170     &       xt_detrainement(niso,klon,klev)
171#endif       
172        REAL xt_wake(ntraciso,klon,klev)   
173#endif
174!!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)     !jyg
175  REAL Ma(klon, klev), mip(klon, klev), Vprecip(klon, klev+1)      !jyg
176  REAL Vprecipi(klon, klev+1)                                      !jyg
177  REAL wght(klon, klev)                                            !RL
178#ifdef ISO
179  REAL xtVprecip(ntraciso,klon, klev+1),xtVprecipi(ntraciso,klon, klev+1)
180#endif
181
182  REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
183! RomP >>>
184  REAL phi2(klon, klev, klev)
185  REAL d1a(klon, klev), dam(klon, klev)
186  REAL sij(klon, klev, klev), clw(klon, klev), elij(klon, klev, klev)
187  REAL wdtrainA(klon, klev), wdtrainM(klon, klev)
188  REAL evap(klon, klev), ep(klon, klev)
189  REAL epmlmMm(klon, klev, klev), eplaMm(klon, klev)
190! RomP <<<
191  REAL cape(klon), cin(klon), tvp(klon, klev)
192  REAL Tconv(klon, klev)
193
194!CR:test: on passe lentr et alim_star des thermiques
195  INTEGER lalim_conv(klon)
196  REAL wght_th(klon, klev)
197  REAL em_sig1feed ! sigma at lower bound of feeding layer
198  REAL em_sig2feed ! sigma at upper bound of feeding layer
199  REAL em_wght(klev) ! weight density determining the feeding mixture
200!on enleve le save
201! SAVE em_sig1feed,em_sig2feed,em_wght
202
203  INTEGER iflag(klon)
204  REAL rflag(klon)
205  REAL pbase(klon), bbase(klon)
206  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
207  REAL dplcldt(klon), dplcldr(klon)
208  REAL qcondc(klon, klev)
209  REAL qtc(klon, klev)
210  REAL sigt(klon, klev)
211  REAL wd(klon)
212  REAL plim1(klon), plim2(klon), asupmax(klon, klev)
213  REAL supmax0(klon), asupmaxmin(klon)
214
215  REAL sigd(klon)
216  REAL zx_t, zdelta, zx_qs, zcor
217  REAL tau_cld_cv, coefw_cld_cv
218  REAL epmax_diag(klon) ! epmax_cape
219
220!   INTEGER iflag_mix
221!   SAVE iflag_mix
222  INTEGER noff, minorig
223  INTEGER i, k, itra
224  REAL qs(klon, klev), qs_wake(klon, klev)
225  REAL cbmf(klon), plcl(klon), plfc(klon), wbeff(klon)
226!LF          SAVE cbmf
227!IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
228!!!$OMP THREADPRIVATE(cbmf)!
229  REAL cbmflast(klon)
230  INTEGER ifrst
231  SAVE ifrst
232  DATA ifrst/0/
233!$OMP THREADPRIVATE(ifrst)
234
235
236! Variables supplementaires liees au bilan d'energie
237! Real paire(klon)
238!LF      Real ql(klon,klev)
239! Save paire
240!LF      Save ql
241!LF      Real t1(klon,klev),q1(klon,klev)
242!LF      Save t1,q1
243! Data paire /1./
244  REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
245!$OMP THREADPRIVATE(ql, q1, t1)
246
247! Variables liees au bilan d'energie et d'enthAlpi
248  REAL ztsol(klon)
249  REAL        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
250              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
251  SAVE        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
252              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
253!$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
254!$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
255  REAL        d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
256  REAL        d_h_vcol_phy
257  REAL        fs_bound, fq_bound
258  SAVE        d_h_vcol_phy
259!$OMP THREADPRIVATE(d_h_vcol_phy)
260  REAL        zero_v(klon)
261  CHARACTER *15 ztit
262  INTEGER     ip_ebil ! PRINT level for energy conserv. diag.
263  SAVE        ip_ebil
264  DATA        ip_ebil/2/
265!$OMP THREADPRIVATE(ip_ebil)
266  INTEGER     if_ebil ! level for energy conserv. dignostics
267  SAVE        if_ebil
268  DATA        if_ebil/2/
269!$OMP THREADPRIVATE(if_ebil)
270!+jld ec_conser
271  REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
272  REAL zrcpd
273!-jld ec_conser
274!LF
275  INTEGER nloc
276  LOGICAL, SAVE            :: first = .TRUE.
277!$OMP THREADPRIVATE(first)
278  INTEGER, SAVE            :: itap, igout
279!$OMP THREADPRIVATE(itap, igout)
280
281
282  include "YOMCST.h"
283  include "YOMCST2.h"
284  include "YOETHF.h"
285  include "FCTTRE.h"
286!jyg<
287  include "conema3.h"
288!>jyg
289
290  IF (first) THEN
291! Allocate some variables LF 04/2008
292
293!IM/JYG allocate(cbmf(klon))
294    ALLOCATE (ql(klon,klev))
295    ALLOCATE (t1(klon,klev))
296    ALLOCATE (q1(klon,klev))
297    itap = 0
298    igout = klon/2 + 1/klon
299  END IF
300! Incrementer le compteur de la physique
301  itap = itap + 1
302
303! Copy T into Tconv
304  DO k = 1, klev
305    DO i = 1, klon
306      Tconv(i, k) = t(i, k)
307    END DO
308  END DO
309
310  IF (if_ebil>=1) THEN
311    DO i = 1, klon
312      ztsol(i) = t(i, 1)
313      zero_v(i) = 0.
314      DO k = 1, klev
315        ql(i, k) = 0.
316#ifdef ISO
317            do ixt=1,ntraciso
318              xtl(ixt,i,k) = 0.
319            enddo
320#endif
321      END DO
322    END DO
323  END IF
324
325! ym
326  snow(:) = 0
327#ifdef ISO
328      xtsnow(:,:)=0
329#endif
330
331! IF (ifrst .EQ. 0) THEN
332! ifrst = 1
333  IF (first) THEN
334    first = .FALSE.
335
336! ===========================================================================
337! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
338! ===========================================================================
339
340    IF (iflag_con==3) THEN
341!      CALL cv3_inicp()
342      CALL cv3_inip()
343    END IF
344
345! ===========================================================================
346! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
347! ===========================================================================
348
349! c$$$         open (56,file='supcrit.data')
350! c$$$         read (56,*) Supcrit1, Supcrit2
351! c$$$         close (56)
352
353    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
354
355! ===========================================================================
356! Initialisation pour les bilans d'eau et d'energie
357! ===========================================================================
358    IF (if_ebil>=1) d_h_vcol_phy = 0.
359
360    DO i = 1, klon
361      cbmf(i) = 0.
362!!          plcl(i) = 0.
363      sigd(i) = 0.
364    END DO
365  END IF !(ifrst .EQ. 0)
366
367! Initialisation a chaque pas de temps
368  plfc(:) = 0.
369  wbeff(:) = 100.
370  plcl(:) = 0.
371
372  DO k = 1, klev + 1
373    DO i = 1, klon
374      em_ph(i, k) = paprs(i, k)/100.0
375      pmflxr(i, k) = 0.
376      pmflxs(i, k) = 0.
377    END DO
378  END DO
379
380  DO k = 1, klev
381    DO i = 1, klon
382      em_p(i, k) = pplay(i, k)/100.0
383    END DO
384  END DO
385
386
387! Feeding layer
388
389  em_sig1feed = 1.
390!jyg<
391!  em_sig2feed = 0.97
392  em_sig2feed = cvl_sig2feed
393!>jyg
394! em_sig2feed = 0.8
395! Relative Weight densities
396  DO k = 1, klev
397    em_wght(k) = 1.
398  END DO
399!CRtest: couche alim des tehrmiques ponderee par a*
400! DO i = 1, klon
401! do k=1,lalim_conv(i)
402! em_wght(k)=wght_th(i,k)
403! print*,'em_wght=',em_wght(k),wght_th(i,k)
404! end do
405! END DO
406
407  IF (iflag_con==4) THEN
408    DO k = 1, klev
409      DO i = 1, klon
410        zx_t = t(i, k)
411        zdelta = max(0., sign(1.,rtt-zx_t))
412        zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
413        zcor = 1./(1.-retv*zx_qs)
414        qs(i, k) = zx_qs*zcor
415      END DO
416      DO i = 1, klon
417        zx_t = t_wake(i, k)
418        zdelta = max(0., sign(1.,rtt-zx_t))
419        zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
420        zcor = 1./(1.-retv*zx_qs)
421        qs_wake(i, k) = zx_qs*zcor
422      END DO
423    END DO
424  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
425    DO k = 1, klev
426      DO i = 1, klon
427        zx_t = t(i, k)
428        zdelta = max(0., sign(1.,rtt-zx_t))
429        zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
430        zx_qs = min(0.5, zx_qs)
431        zcor = 1./(1.-retv*zx_qs)
432        zx_qs = zx_qs*zcor
433        qs(i, k) = zx_qs
434      END DO
435      DO i = 1, klon
436        zx_t = t_wake(i, k)
437        zdelta = max(0., sign(1.,rtt-zx_t))
438        zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
439        zx_qs = min(0.5, zx_qs)
440        zcor = 1./(1.-retv*zx_qs)
441        zx_qs = zx_qs*zcor
442        qs_wake(i, k) = zx_qs
443      END DO
444    END DO
445  END IF ! iflag_con
446
447! ------------------------------------------------------------------
448
449! Main driver for convection:
450!                   iflag_con=3 -> nvlle version de KE (JYG)
451!                   iflag_con = 30  -> equivAlent to convect3
452!                   iflag_con = 4  -> equivAlent to convect1/2
453
454
455  IF (iflag_con==30) THEN
456
457 
458#ifdef ISO         
459#ifdef ISOVERIF
460       do k = 1, klev
461        do i = 1, klon               
462         do ixt=1,ntraciso         
463             call iso_verif_noNaN(xt(ixt,i,k),'concvl 394')
464         enddo
465        enddo !do i = 1, klon
466       enddo !do k = 1, klev       
467       if (iso_eau.gt.0) then
468       do k = 1, klev
469        do i = 1, klon         
470          call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
471     &            'concvl 174',errmax,errmaxrel)
472        enddo !do i = 1, klon
473       enddo !do k = 1, klev   
474       endif !if (iso_eau.gt.0) then
475       if (iso_HDO.gt.0) then
476       do k = 1, klev
477        do i = 1, klon         
478         if (q(i,k).gt.ridicule) then
479          call iso_verif_aberrant(xt(iso_hdo,i,k)/q(i,k),'concvl 174')
480         endif ! if (q(i,k).gt.ridicule) then
481        enddo
482       enddo   
483       endif !if (iso_eau.gt.0) then
484#ifdef ISOTRAC
485        do k = 1, klev
486        do i = 1, klon   
487           call iso_verif_traceur(xt(1,i,k),'concvl 218')
488        enddo
489        enddo
490#endif       
491       write(*,*) 'concvl 170: avant appel cv_driver'
492#endif
493        ! ISOVERIF ! end verif       
494#endif
495
496! print *, '-> cv_driver'      !jyg
497    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
498                   t, q, qs, u, v, tra, &
499                   em_p, em_ph, iflag, &
500                   d_t, d_q, d_u, d_v, d_tra, rain, &
501                   Vprecip, cbmf, sig1, w01, & !jyg
502                   kbas, ktop, &
503                   dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
504                   da, phi, mp, phi2, d1a, dam, sij, clw, elij, &       !RomP
505                   evap, ep, epmlmMm, eplaMm, &                         !RomP
506                   wdtrainA, wdtrainM, &                                !RomP
507                   epmax_diag & ! epmax_cape
508#ifdef ISO
509     &             ,xt,d_xt,xtrain,xtVprecip &
510#ifdef DIAGISO
511     &          , qlp,xtlp,qvp,xtvp,xtevap,xtclw & ! juste diagnostique 
512     &          , wdtrain, xtwdtrain,tadiab &
513     &          , taux_cond_conv &
514     &          , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
515     &          , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
516     &          , fxt_evapprecip,Mi,Amp_diag,tcond &
517     &          , f_detrainement,q_detrainement,xt_detrainement &
518#endif     
519#endif
520     &              )
521!           print *, 'cv_driver ->'      !jyg
522
523#ifdef ISO
524      ! verif
525#ifdef ISOVERIF
526       write(*,*) 'concvl 463: après appel cv_driver'
527       do k = 1, klev
528        do i = 1, klon
529        if (iso_eau.gt.0) then
530            call iso_verif_egalite(xt(iso_eau,i,k),q(i,k),'concvl 203')
531            call iso_verif_egalite(d_xt(iso_eau,i,k),d_q(i,k), &
532     &            'concvl 452')
533         endif !if (iso_eau.gt.0) then
534#ifdef DIAGISO
535         do ixt=1,niso
536            call iso_verif_noNaN(xt(ixt,i,k),'concvl 460')
537            call iso_verif_noNaN(xtlp(ixt,i,k),'concvl 295')
538            call iso_verif_noNaN(xtvp(ixt,i,k),'concvl 260')
539          enddo
540          call iso_verif_positif(tcond(i,k)-50.0,'concvl 277')
541          call iso_verif_noNaN(tcond(i,k),'concvl 278')
542#endif                 
543        enddo
544       enddo       
545#ifdef ISOTRAC
546           call iso_verif_traceur_vect(xt,klon,klev,'concvl 218')
547           call iso_verif_trac_masse_vect(d_xt,klon,klev, &
548     &           'concvl 464',errmax,errmaxrel)
549#endif           
550#endif
551       ! end verif       
552#endif
553
554    DO i = 1, klon
555      cbmf(i) = Ma(i, kbas(i))
556    END DO
557
558!RL
559    wght(:, :) = 0.
560    DO i = 1, klon
561      wght(i, 1) = 1.
562    END DO
563!RL
564
565  ELSE
566
567!LF   necessary for gathered fields
568    nloc = klon
569
570    CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
571                    iflag_con, iflag_mix, iflag_ice_thermo, &
572                    iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
573                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
574                    em_p, em_ph, &
575                    Ale, Alp, omega, &
576                    em_sig1feed, em_sig2feed, em_wght, &
577                    iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
578                    cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
579                    Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
580                    cape, cin, tvp, &
581                    dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
582                    asupmaxmin, lalim_conv, &
583!AC!+!RomP+jyg
584!!                   da,phi,mp,phi2,d1a,dam,sij,clw,elij, &               ! RomP
585!!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
586                    da, phi, mp, phi2, d1a, dam, sij, wght, &           ! RomP+RL
587                    clw, elij, evap, ep, epmlmMm, eplaMm, &             ! RomP+RL
588                    wdtrainA, wdtrainM, qtc, sigt, &
589                    tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
590!AC!+!RomP+jyg
591                    epmax_diag & ! epmax_cape
592#ifdef ISO
593     &             ,xt,xt_wake,d_xt, xtrain,dd_xt &
594     &             ,xtVprecip,xtVprecipi &
595#ifdef DIAGISO     
596     &          , qlp,xtlp,qvp,xtvp,xtevap &
597     &          , xtclw & ! juste diagnostique 
598     &          , wdtrain, xtwdtrain,tadiab &
599     &          , taux_cond_conv &
600     &          , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
601     &          , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
602     &          , fxt_evapprecip,Mi,Amp_diag,tcond,mp &
603     &          , f_detrainement,q_detrainement,xt_detrainement &
604#endif     
605#endif
606     &          )             
607  END IF
608! ------------------------------------------------------------------
609  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff ', &
610                                         cbmf(1), plcl(1), plfc(1), wbeff(1)
611
612  DO i = 1, klon
613    rain(i) = rain(i)/86400.
614    rflag(i) = iflag(i)
615#ifdef ISO
616       do ixt = 1, ntraciso
617        xtrain(ixt,i) = xtrain(ixt,i)/86400.
618       enddo
619#endif
620  END DO
621
622  DO k = 1, klev
623    DO i = 1, klon
624      d_t(i, k) = dtime*d_t(i, k)
625      d_q(i, k) = dtime*d_q(i, k)
626      d_u(i, k) = dtime*d_u(i, k)
627      d_v(i, k) = dtime*d_v(i, k)
628#ifdef ISO
629           do ixt = 1, ntraciso
630            d_xt(ixt,i,k) = dtime*d_xt(ixt,i,k)
631           enddo
632#ifdef ISOVERIF
633           if (iso_HDO.gt.0) then
634             if (q(i,k).gt.ridicule) then
635                 call iso_verif_aberrant((xt(iso_HDO,i,k) &
636     &        +d_xt(iso_HDO,i,k))/(q(i,k)+d_q(i,k)),'concvl 250')
637             endif !if (q_seri(i,k).gt.ridicule) then
638          endif !if (iso_HDO.gt.0) then
639           if (iso_eau.gt.0) then
640             call iso_verif_egalite_choix(d_xt(iso_eau,i,k), &
641     &          d_q(i,k),'concvl 530',errmax*dtime,errmaxrel)
642          endif !if (iso_HDO.gt.0) then
643#ifdef ISOTRAC
644           call iso_verif_traceur_justmass(d_xt(1,i,k),'concvl 316')
645#endif           
646#endif
647#endif
648    END DO
649  END DO
650
651#ifdef ISO
652      if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
653        do k=1,klev   
654        do i=1,klon
655            d_xt(iso_eau,i,k)=d_q(i,k)
656        enddo !do i=1,klon
657        enddo !do k=1,klev               
658#ifdef ISOTRAC 
659        call iso_verif_traceur_jbid_vect(d_xt, &
660     &            klon,klev)   
661#endif         
662      endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then 
663#endif
664
665  IF (iflag_con==30) THEN
666    DO itra = 1, ntra
667      DO k = 1, klev
668        DO i = 1, klon
669!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
670          d_tra(i, k, itra) = 0.
671        END DO
672      END DO
673    END DO
674  END IF
675
676!!AC!
677  IF (iflag_con==3) THEN
678    DO itra = 1, ntra
679      DO k = 1, klev
680        DO i = 1, klon
681!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
682          d_tra(i, k, itra) = 0.
683        END DO
684      END DO
685    END DO
686  END IF
687!!AC!
688
689  DO k = 1, klev
690    DO i = 1, klon
691      t1(i, k) = t(i, k) + d_t(i, k)
692      q1(i, k) = q(i, k) + d_q(i, k)
693#ifdef ISO
694            do ixt=1,ntraciso
695               xt1(ixt,i,k) = xt(ixt,i,k)+ d_xt(ixt,i,k)
696            enddo
697#ifdef ISOVERIF
698            do ixt=1,ntraciso
699              call iso_verif_noNaN(xt1(ixt,i,k),'concvl 584')
700            enddo !do ixt=1,ntraciso
701#endif           
702#endif
703    END DO
704  END DO
705
706#ifdef ISO
707#ifdef ISOVERIF     
708#ifdef ISOTRAC
709           call iso_verif_traceur_vect(xt1,klon,klev,'concvl 583')
710#endif
711      write(*,*) 'concvl 588: sortie de concvl'
712#endif
713#endif
714!                                                     !jyg
715  IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
716! --Separation neige/pluie (pour diagnostics)         !jyg
717    DO k = 1, klev                                    !jyg
718      DO i = 1, klon                                  !jyg
719        IF (t1(i,k)<rtt) THEN                         !jyg
720          pmflxs(i, k) = Vprecip(i, k)                !jyg
721        ELSE                                          !jyg
722          pmflxr(i, k) = Vprecip(i, k)                !jyg
723        END IF                                        !jyg
724      END DO                                          !jyg
725    END DO                                            !jyg
726  ELSE
727    DO k = 1, klev                                    !jyg
728      DO i = 1, klon                                  !jyg
729        pmflxs(i, k) = Vprecipi(i, k)                 !jyg
730        pmflxr(i, k) = Vprecip(i, k)-Vprecipi(i, k)   !jyg
731      END DO                                          !jyg
732    END DO                                            !jyg
733  ENDIF
734
735! c      IF (if_ebil.ge.2) THEN
736! c        ztit='after convect'
737! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
738! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
739! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
740! c         call diagphy(paire,ztit,ip_ebil
741! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
742! c     e      , zero_v, rain, zero_v, ztsol
743! c     e      , d_h_vcol, d_qt, d_ec
744! c     s      , fs_bound, fq_bound )
745! c      END IF
746
747
748! les traceurs ne sont pas mis dans cette version de convect4:
749  IF (iflag_con==4) THEN
750    DO itra = 1, ntra
751      DO k = 1, klev
752        DO i = 1, klon
753          d_tra(i, k, itra) = 0.
754        END DO
755      END DO
756    END DO
757  END IF
758! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
759
760  DO k = 1, klev
761    DO i = 1, klon
762      dtvpdt1(i, k) = 0.
763      dtvpdq1(i, k) = 0.
764    END DO
765  END DO
766  DO i = 1, klon
767    dplcldt(i) = 0.
768    dplcldr(i) = 0.
769  END DO
770
771  IF (prt_level>=20) THEN
772    DO k = 1, klev
773! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
774!         k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
775!         d_q_con(igout,k),dql0(igout,k)
776! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
777!         itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
778!         t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
779! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
780!         itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
781!         ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
782! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
783!         itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
784!         tvp(igout,k),Tconv(igout,k)
785! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
786!         itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
787!         dplcldr(igout),qcondc(igout,k)
788! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
789!         itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
790!         pmflxs(igout,k+1)
791! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
792!         itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
793!         fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
794    END DO
795  END IF !(prt_level.EQ.20) THEN
796
797  RETURN
798END SUBROUTINE concvl
799
Note: See TracBrowser for help on using the repository browser.