source: LMDZ6/trunk/libf/phylmd/concvl.F90 @ 3435

Last change on this file since 3435 was 3197, checked in by jyg, 6 years ago

small bug in cv3_yield in cv3_routines.F90

  • 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: 20.7 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, convoccur, &
8                  upwd, dnwd, dnwdbis, &
9                  Ma, mip, Vprecip, &
10                  cape, cin, tvp, Tconv, iflag, &
11                  pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
12                  qcondc, wd, pmflxr, pmflxs, &
13!RomP >>>
14!!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
15                  da, phi, mp, phii, d1a, dam, sij, clw, elij, &     ! RomP
16                  dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
17                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
18                  wdtrainA, wdtrainM, wght, qtc, sigt, &
19                  tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
20!RomP <<<
21                  epmax_diag) ! epmax_cape
22! **************************************************************
23! *
24! CONCVL                                                      *
25! *
26! *
27! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
28! modified by :                                               *
29! **************************************************************
30
31
32  USE dimphy
33  USE infotrac_phy, ONLY: nbtr
34  USE phys_local_var_mod, ONLY: omega
35  USE print_control_mod, ONLY: prt_level, lunout
36  IMPLICIT NONE
37! ======================================================================
38! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
39! Objet: schema de convection de Emanuel (1991) interface
40! ======================================================================
41! Arguments:
42! dtime--input-R-pas d'integration (s)
43! s-------input-R-la vAleur "s" pour chaque couche
44! sigs----input-R-la vAleur "sigma" de chaque couche
45! sig-----input-R-la vAleur de "sigma" pour chaque niveau
46! psolpa--input-R-la pression au sol (en Pa)
47! pskapa--input-R-exponentiel kappa de psolpa
48! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)
49! q-------input-R-vapeur d'eau (en kg/kg)
50
51! work*: input et output: deux variables de travail,
52! on peut les mettre a 0 au debut
53! ALE--------input-R-energie disponible pour soulevement
54! ALP--------input-R-puissance disponible pour soulevement
55
56! d_h--------output-R-increment de l'enthAlpie potentielle (h)
57! d_q--------output-R-increment de la vapeur d'eau
58! rain-------output-R-la pluie (mm/s)
59! snow-------output-R-la neige (mm/s)
60! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
61! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
62! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
63! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
64! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
65! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)
66! Tconv------output-R-environment temperature seen by convective scheme (K)
67! Cape-------output-R-CAPE (J/kg)
68! Cin -------output-R-CIN  (J/kg)
69! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
70! adiabatiquement a partir du niveau 1 (K)
71! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
72! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
73! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
74! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
75! lalim_conv-
76! wght_th----
77! evap-------output-R
78! ep---------output-R
79! epmlmMm----output-R
80! eplaMm-----output-R
81! wdtrainA---output-R
82! wdtrainM---output-R
83! wght-------output-R
84! ======================================================================
85
86
87  include "clesphys.h"
88
89  INTEGER, INTENT(IN)                           :: iflag_clos
90  REAL, INTENT(IN)                              :: dtime
91  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: pplay
92  REAL, DIMENSION(klon,klev+1), INTENT(IN)      :: paprs
93  INTEGER,                      INTENT(IN)      :: k_upper_cv
94  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: t, q, u, v
95  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: t_wake, q_wake
96  REAL, DIMENSION(klon),        INTENT(IN)      :: s_wake
97  REAL, DIMENSION(klon,klev, nbtr),INTENT(IN)   :: tra
98  INTEGER,                      INTENT(IN)      :: ntra
99  REAL, DIMENSION(klon),        INTENT(IN)      :: Ale, Alp
100!CR:test: on passe lentr et alim_star des thermiques
101  INTEGER, DIMENSION(klon),     INTENT(IN)      :: lalim_conv
102  REAL, DIMENSION(klon,klev),   INTENT(IN)      :: wght_th
103
104  REAL, DIMENSION(klon,klev),   INTENT(INOUT)   :: sig1, w01
105
106  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d_t, d_q, d_u, d_v
107  REAL, DIMENSION(klon,klev, nbtr),INTENT(OUT)  :: d_tra
108  REAL, DIMENSION(klon),        INTENT(OUT)     :: rain, snow
109
110  INTEGER, DIMENSION(klon),     INTENT(OUT)     :: kbas, ktop
111  REAL, DIMENSION(klon),        INTENT(OUT)     :: sigd
112  REAL, DIMENSION(klon),        INTENT(OUT)     :: cbmf, plcl, plfc, wbeff
113  REAL, DIMENSION(klon),        INTENT(OUT)     :: convoccur
114  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: upwd, dnwd, dnwdbis
115
116!!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)                    !jyg
117  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: Ma, mip
118  REAL, DIMENSION(klon,klev+1), INTENT(OUT)     :: Vprecip                        !jyg
119  REAL, DIMENSION(klon),        INTENT(OUT)     :: cape, cin
120  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: tvp
121  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: Tconv
122  INTEGER, DIMENSION(klon),     INTENT(OUT)     :: iflag
123  REAL, DIMENSION(klon),        INTENT(OUT)     :: pbase, bbase
124  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: dtvpdt1, dtvpdq1
125  REAL, DIMENSION(klon),        INTENT(OUT)     :: dplcldt, dplcldr
126  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qcondc
127  REAL, DIMENSION(klon),        INTENT(OUT)     :: wd
128  REAL, DIMENSION(klon,klev+1), INTENT(OUT)     :: pmflxr, pmflxs
129
130  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: da, mp
131  REAL, DIMENSION(klon,klev,klev),INTENT(OUT)   :: phi
132! RomP >>>
133  REAL, DIMENSION(klon,klev,klev),INTENT(OUT)   :: phii
134  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: d1a, dam
135  REAL, DIMENSION(klon,klev,klev),INTENT(OUT)   :: sij, elij
136  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: clw
137  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: dd_t, dd_q
138  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: evap, ep
139  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: eplaMm
140  REAL, DIMENSION(klon,klev,klev), INTENT(OUT)  :: epmlmMm
141  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: wdtrainA, wdtrainM
142! RomP <<<
143  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: wght                       !RL
144  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: qtc
145  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: sigt
146  REAL,                         INTENT(OUT)     :: tau_cld_cv, coefw_cld_cv
147  REAL, DIMENSION(klon),        INTENT(OUT)     :: epmax_diag                ! epmax_cape
148
149!
150!  Local
151!  ----
152  REAL, DIMENSION(klon,klev)                    :: em_p
153  REAL, DIMENSION(klon,klev+1)                  :: em_ph
154  REAL                                          :: em_sig1feed ! sigma at lower bound of feeding layer
155  REAL                                          :: em_sig2feed ! sigma at upper bound of feeding layer
156  REAL, DIMENSION(klev)                         :: em_wght ! weight density determining the feeding mixture
157  REAL, DIMENSION(klon,klev+1)                  :: Vprecipi                       !jyg
158!on enleve le save
159! SAVE em_sig1feed,em_sig2feed,em_wght
160
161  REAL, DIMENSION(klon)                         :: rflag
162  REAL, DIMENSION(klon)                         :: plim1, plim2
163  REAL, DIMENSION(klon)                         :: ptop2
164  REAL, DIMENSION(klon,klev)                    :: asupmax
165  REAL, DIMENSION(klon)                         :: supmax0, asupmaxmin
166  REAL                                          :: zx_t, zdelta, zx_qs, zcor
167!
168!   INTEGER iflag_mix
169!   SAVE iflag_mix
170  INTEGER                                       :: noff, minorig
171  INTEGER                                       :: i,j, k, itra
172  REAL, DIMENSION(klon,klev)                    :: qs, qs_wake
173!LF          SAVE cbmf
174!IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
175!!!$OMP THREADPRIVATE(cbmf)!
176  REAL, DIMENSION(klon)                         :: cbmflast
177
178
179! Variables supplementaires liees au bilan d'energie
180! Real paire(klon)
181!LF      Real ql(klon,klev)
182! Save paire
183!LF      Save ql
184!LF      Real t1(klon,klev),q1(klon,klev)
185!LF      Save t1,q1
186! Data paire /1./
187  REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
188!$OMP THREADPRIVATE(ql, q1, t1)
189
190! Variables liees au bilan d'energie et d'enthAlpi
191  REAL ztsol(klon)
192  REAL        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
193              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
194  SAVE        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
195              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
196!$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
197!$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
198  REAL        d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
199  REAL        d_h_vcol_phy
200  REAL        fs_bound, fq_bound
201  SAVE        d_h_vcol_phy
202!$OMP THREADPRIVATE(d_h_vcol_phy)
203  REAL        zero_v(klon)
204  CHARACTER *15 ztit
205  INTEGER     ip_ebil ! PRINT level for energy conserv. diag.
206  SAVE        ip_ebil
207  DATA        ip_ebil/2/
208!$OMP THREADPRIVATE(ip_ebil)
209  INTEGER     if_ebil ! level for energy conserv. dignostics
210  SAVE        if_ebil
211  DATA        if_ebil/2/
212!$OMP THREADPRIVATE(if_ebil)
213!+jld ec_conser
214  REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
215  REAL zrcpd
216!-jld ec_conser
217!LF
218  INTEGER nloc
219  LOGICAL, SAVE            :: first = .TRUE.
220!$OMP THREADPRIVATE(first)
221  INTEGER, SAVE            :: itap, igout
222!$OMP THREADPRIVATE(itap, igout)
223
224
225  include "YOMCST.h"
226  include "YOMCST2.h"
227  include "YOETHF.h"
228  include "FCTTRE.h"
229!jyg<
230  include "conema3.h"
231!>jyg
232
233  IF (first) THEN
234! Allocate some variables LF 04/2008
235
236!IM/JYG allocate(cbmf(klon))
237    ALLOCATE (ql(klon,klev))
238    ALLOCATE (t1(klon,klev))
239    ALLOCATE (q1(klon,klev))
240!
241    convoccur(:) = 0.
242!
243    itap = 0
244    igout = klon/2 + 1/klon
245  END IF
246! Incrementer le compteur de la physique
247  itap = itap + 1
248
249! Copy T into Tconv
250  DO k = 1, klev
251    DO i = 1, klon
252      Tconv(i, k) = t(i, k)
253    END DO
254  END DO
255
256  IF (if_ebil>=1) THEN
257    DO i = 1, klon
258      ztsol(i) = t(i, 1)
259      zero_v(i) = 0.
260      DO k = 1, klev
261        ql(i, k) = 0.
262      END DO
263    END DO
264  END IF
265
266! ym
267  snow(:) = 0
268
269  IF (first) THEN
270    first = .FALSE.
271
272! ===========================================================================
273! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
274! ===========================================================================
275
276    IF (iflag_con==3) THEN
277!      CALL cv3_inicp()
278      CALL cv3_inip()
279    END IF
280
281! ===========================================================================
282! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
283! ===========================================================================
284
285! c$$$         open (56,file='supcrit.data')
286! c$$$         read (56,*) Supcrit1, Supcrit2
287! c$$$         close (56)
288
289    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
290
291! ===========================================================================
292! Initialisation pour les bilans d'eau et d'energie
293! ===========================================================================
294    IF (if_ebil>=1) d_h_vcol_phy = 0.
295
296    DO i = 1, klon
297      cbmf(i) = 0.
298!!          plcl(i) = 0.
299      sigd(i) = 0.
300    END DO
301  END IF !(first)
302
303! Initialisation a chaque pas de temps
304  plfc(:) = 0.
305  wbeff(:) = 100.
306  plcl(:) = 0.
307
308  DO k = 1, klev + 1
309    DO i = 1, klon
310      em_ph(i, k) = paprs(i, k)/100.0
311      pmflxr(i, k) = 0.
312      pmflxs(i, k) = 0.
313    END DO
314  END DO
315
316  DO k = 1, klev
317    DO i = 1, klon
318      em_p(i, k) = pplay(i, k)/100.0
319    END DO
320  END DO
321
322
323! Feeding layer
324
325  em_sig1feed = 1.
326!jyg<
327!  em_sig2feed = 0.97
328  em_sig2feed = cvl_sig2feed
329!>jyg
330! em_sig2feed = 0.8
331! Relative Weight densities
332  DO k = 1, klev
333    em_wght(k) = 1.
334  END DO
335!CRtest: couche alim des tehrmiques ponderee par a*
336! DO i = 1, klon
337! do k=1,lalim_conv(i)
338! em_wght(k)=wght_th(i,k)
339! print*,'em_wght=',em_wght(k),wght_th(i,k)
340! end do
341! END DO
342
343  IF (iflag_con==4) THEN
344    DO k = 1, klev
345      DO i = 1, klon
346        zx_t = t(i, k)
347        zdelta = max(0., sign(1.,rtt-zx_t))
348        zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
349        zcor = 1./(1.-retv*zx_qs)
350        qs(i, k) = zx_qs*zcor
351      END DO
352      DO i = 1, klon
353        zx_t = t_wake(i, k)
354        zdelta = max(0., sign(1.,rtt-zx_t))
355        zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
356        zcor = 1./(1.-retv*zx_qs)
357        qs_wake(i, k) = zx_qs*zcor
358      END DO
359    END DO
360  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
361    DO k = 1, klev
362      DO i = 1, klon
363        zx_t = t(i, k)
364        zdelta = max(0., sign(1.,rtt-zx_t))
365        zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
366        zx_qs = min(0.5, zx_qs)
367        zcor = 1./(1.-retv*zx_qs)
368        zx_qs = zx_qs*zcor
369        qs(i, k) = zx_qs
370      END DO
371      DO i = 1, klon
372        zx_t = t_wake(i, k)
373        zdelta = max(0., sign(1.,rtt-zx_t))
374        zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
375        zx_qs = min(0.5, zx_qs)
376        zcor = 1./(1.-retv*zx_qs)
377        zx_qs = zx_qs*zcor
378        qs_wake(i, k) = zx_qs
379      END DO
380    END DO
381  END IF ! iflag_con
382
383! ------------------------------------------------------------------
384
385! Main driver for convection:
386!                   iflag_con=3 -> nvlle version de KE (JYG)
387!                   iflag_con = 30  -> equivAlent to convect3
388!                   iflag_con = 4  -> equivAlent to convect1/2
389
390
391  IF (iflag_con==30) THEN
392
393! print *, '-> cv_driver'      !jyg
394    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
395                   t, q, qs, u, v, tra, &
396                   em_p, em_ph, iflag, &
397                   d_t, d_q, d_u, d_v, d_tra, rain, &
398                   Vprecip, cbmf, sig1, w01, & !jyg
399                   kbas, ktop, &
400                   dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
401                   da, phi, mp, phii, d1a, dam, sij, clw, elij, &       !RomP
402                   evap, ep, epmlmMm, eplaMm, &                         !RomP
403                   wdtrainA, wdtrainM, &                                !RomP
404                   epmax_diag) ! epmax_cape
405!           print *, 'cv_driver ->'      !jyg
406
407    DO i = 1, klon
408      cbmf(i) = Ma(i, kbas(i))
409    END DO
410
411!RL
412    wght(:, :) = 0.
413    DO i = 1, klon
414      wght(i, 1) = 1.
415    END DO
416!RL
417
418  ELSE
419
420!LF   necessary for gathered fields
421    nloc = klon
422    CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
423                    iflag_con, iflag_mix, iflag_ice_thermo, &
424                    iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
425                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
426                    em_p, em_ph, &
427                    Ale, Alp, omega, &
428                    em_sig1feed, em_sig2feed, em_wght, &
429                    iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
430                    cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
431                    Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
432                    cape, cin, tvp, &
433                    dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
434                    asupmaxmin, lalim_conv, &
435!AC!+!RomP+jyg
436!!                   da,phi,mp,phii,d1a,dam,sij,clw,elij, &               ! RomP
437!!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
438                    da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
439                    clw, elij, evap, ep, epmlmMm, eplaMm, &             ! RomP+RL
440                    wdtrainA, wdtrainM, qtc, sigt, &
441                    tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
442!AC!+!RomP+jyg
443                    epmax_diag) ! epmax_cape
444  END IF
445! ------------------------------------------------------------------
446  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', &
447                                         cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1,1), d_q(1,1)
448
449  DO i = 1, klon
450    rain(i) = rain(i)/86400.
451    rflag(i) = iflag(i)
452  END DO
453
454  DO k = 1, klev
455    DO i = 1, klon
456      d_t(i, k) = dtime*d_t(i, k)
457      d_q(i, k) = dtime*d_q(i, k)
458      d_u(i, k) = dtime*d_u(i, k)
459      d_v(i, k) = dtime*d_v(i, k)
460    END DO
461  END DO
462
463  IF (iflag_con==3) THEN
464    DO i = 1,klon
465      IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN
466        wbeff(i) = 0.
467        convoccur(i) = 0. 
468      ELSE
469        convoccur(i) = 1.
470      ENDIF
471    ENDDO
472  ENDIF
473
474  IF (iflag_con==30) THEN
475    DO itra = 1, ntra
476      DO k = 1, klev
477        DO i = 1, klon
478!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
479          d_tra(i, k, itra) = 0.
480        END DO
481      END DO
482    END DO
483  END IF
484
485!!AC!
486  IF (iflag_con==3) THEN
487    DO itra = 1, ntra
488      DO k = 1, klev
489        DO i = 1, klon
490!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
491          d_tra(i, k, itra) = 0.
492        END DO
493      END DO
494    END DO
495  END IF
496!!AC!
497
498  DO k = 1, klev
499    DO i = 1, klon
500      t1(i, k) = t(i, k) + d_t(i, k)
501      q1(i, k) = q(i, k) + d_q(i, k)
502    END DO
503  END DO
504!                                                     !jyg
505  IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
506! --Separation neige/pluie (pour diagnostics)         !jyg
507    DO k = 1, klev                                    !jyg
508      DO i = 1, klon                                  !jyg
509        IF (t1(i,k)<rtt) THEN                         !jyg
510          pmflxs(i, k) = Vprecip(i, k)                !jyg
511        ELSE                                          !jyg
512          pmflxr(i, k) = Vprecip(i, k)                !jyg
513        END IF                                        !jyg
514      END DO                                          !jyg
515    END DO                                            !jyg
516  ELSE
517    DO k = 1, klev                                    !jyg
518      DO i = 1, klon                                  !jyg
519        pmflxs(i, k) = Vprecipi(i, k)                 !jyg
520        pmflxr(i, k) = Vprecip(i, k)-Vprecipi(i, k)   !jyg
521      END DO                                          !jyg
522    END DO                                            !jyg
523  ENDIF
524
525! c      IF (if_ebil.ge.2) THEN
526! c        ztit='after convect'
527! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
528! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
529! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
530! c         call diagphy(paire,ztit,ip_ebil
531! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
532! c     e      , zero_v, rain, zero_v, ztsol
533! c     e      , d_h_vcol, d_qt, d_ec
534! c     s      , fs_bound, fq_bound )
535! c      END IF
536
537
538! les traceurs ne sont pas mis dans cette version de convect4:
539  IF (iflag_con==4) THEN
540    DO itra = 1, ntra
541      DO k = 1, klev
542        DO i = 1, klon
543          d_tra(i, k, itra) = 0.
544        END DO
545      END DO
546    END DO
547  END IF
548! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
549
550  DO k = 1, klev
551    DO i = 1, klon
552      dtvpdt1(i, k) = 0.
553      dtvpdq1(i, k) = 0.
554    END DO
555  END DO
556  DO i = 1, klon
557    dplcldt(i) = 0.
558    dplcldr(i) = 0.
559  END DO
560
561  IF (prt_level>=20) THEN
562    DO k = 1, klev
563! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
564!         k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
565!         d_q_con(igout,k),dql0(igout,k)
566! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
567!         itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
568!         t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
569! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
570!         itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
571!         ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
572! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
573!         itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
574!         tvp(igout,k),Tconv(igout,k)
575! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
576!         itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
577!         dplcldr(igout),qcondc(igout,k)
578! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
579!         itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
580!         pmflxs(igout,k+1)
581! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
582!         itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
583!         fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
584    END DO
585  END IF !(prt_level.EQ.20) THEN
586
587  RETURN
588END SUBROUTINE concvl
589
Note: See TracBrowser for help on using the repository browser.