source: LMDZ6/trunk/libf/phylmd/concvl.f90 @ 5409

Last change on this file since 5409 was 5304, checked in by abarral, 7 weeks ago

Turn YOMCST2.h.h into module

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