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

Last change on this file since 3709 was 3496, checked in by jyg, 6 years ago

Implementation of the ejection of liquid precipitation from the adiabatic ascents.
New flags:
+cvflag_prec_eject: logical

n -> old code, y -> new code

+ejectliq: real; possible values 0. & 1.

  1. -> no liquid precipitation is ejected
  2. -> all liquid precipitation is ejected

+ejectice: real; any value between 0. and 1.

fraction of solid precipitation ejected at each level

Note that the adiabatic ascent mass flux decrease due to precipitation ejection is not taken into account.

Attempts to do it led to water conservation violation.

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