source: LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90 @ 5128

Last change on this file since 5128 was 5112, checked in by abarral, 5 months ago

Rename modules in phy_common from *_mod > lmdz_*

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