source: LMDZ6/branches/Ocean_skin/libf/phylmd/concvl.F90 @ 5054

Last change on this file since 5054 was 3605, checked in by lguez, 5 years ago

Merge revisions 3427:3600 of trunk into branch Ocean_skin

  • 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_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, &
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! 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_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
148  REAL,                         INTENT(OUT)     :: tau_cld_cv, coefw_cld_cv
149  REAL, DIMENSION(klon),        INTENT(OUT)     :: epmax_diag                ! epmax_cape
150
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
160!on enleve le save
161! SAVE em_sig1feed,em_sig2feed,em_wght
162
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!
170!   INTEGER iflag_mix
171!   SAVE iflag_mix
172  INTEGER                                       :: noff, minorig
173  INTEGER                                       :: i,j, k, itra
174  REAL, DIMENSION(klon,klev)                    :: qs, qs_wake
175!LF          SAVE cbmf
176!IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
177!!!$OMP THREADPRIVATE(cbmf)!
178  REAL, DIMENSION(klon)                         :: cbmflast
179
180
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./
189  REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
190!$OMP THREADPRIVATE(ql, q1, t1)
191
192! Variables liees au bilan d'energie et d'enthAlpi
193  REAL ztsol(klon)
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)
206  CHARACTER *15 ztit
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
216  REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
217  REAL zrcpd
218!-jld ec_conser
219!LF
220  INTEGER nloc
221  LOGICAL, SAVE            :: first = .TRUE.
222!$OMP THREADPRIVATE(first)
223  INTEGER, SAVE            :: itap, igout
224!$OMP THREADPRIVATE(itap, igout)
225
226
227  include "YOMCST.h"
228  include "YOMCST2.h"
229  include "YOETHF.h"
230  include "FCTTRE.h"
231!jyg<
232  include "conema3.h"
233!>jyg
234
235  IF (first) THEN
236! Allocate some variables LF 04/2008
237
238!IM/JYG allocate(cbmf(klon))
239    ALLOCATE (ql(klon,klev))
240    ALLOCATE (t1(klon,klev))
241    ALLOCATE (q1(klon,klev))
242!
243    convoccur(:) = 0.
244!
245    itap = 0
246    igout = klon/2 + 1/klon
247  END IF
248! Incrementer le compteur de la physique
249  itap = itap + 1
250
251! Copy T into Tconv
252  DO k = 1, klev
253    DO i = 1, klon
254      Tconv(i, k) = t(i, k)
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.
262      DO k = 1, klev
263        ql(i, k) = 0.
264      END DO
265    END DO
266  END IF
267
268! ym
269  snow(:) = 0
270
271  IF (first) THEN
272    first = .FALSE.
273
274! ===========================================================================
275! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
276! ===========================================================================
277
278    IF (iflag_con==3) THEN
279!      CALL cv3_inicp()
280      CALL cv3_inip()
281    END IF
282
283! ===========================================================================
284! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
285! ===========================================================================
286
287! c$$$         open (56,file='supcrit.data')
288! c$$$         read (56,*) Supcrit1, Supcrit2
289! c$$$         close (56)
290
291    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
292
293! ===========================================================================
294! Initialisation pour les bilans d'eau et d'energie
295! ===========================================================================
296    IF (if_ebil>=1) d_h_vcol_phy = 0.
297
298    DO i = 1, klon
299      cbmf(i) = 0.
300!!          plcl(i) = 0.
301      sigd(i) = 0.
302    END DO
303  END IF !(first)
304
305! Initialisation a chaque pas de temps
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
325! Feeding layer
326
327  em_sig1feed = 1.
328!jyg<
329!  em_sig2feed = 0.97
330  em_sig2feed = cvl_sig2feed
331!>jyg
332! em_sig2feed = 0.8
333! Relative Weight densities
334  DO k = 1, klev
335    em_wght(k) = 1.
336  END DO
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
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
362  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
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
385! ------------------------------------------------------------------
386
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
391
392
393  IF (iflag_con==30) THEN
394
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, &
403                   da, phi, mp, phii, d1a, dam, sij, clw, elij, &       !RomP
404                   evap, ep, epmlmMm, eplaMm, &                         !RomP
405                   wdtrainA, wdtrainM, &                                !RomP
406                   epmax_diag) ! epmax_cape
407!           print *, 'cv_driver ->'      !jyg
408
409    DO i = 1, klon
410      cbmf(i) = Ma(i, kbas(i))
411    END DO
412
413!RL
414    wght(:, :) = 0.
415    DO i = 1, klon
416      wght(i, 1) = 1.
417    END DO
418!RL
419
420  ELSE
421
422!LF   necessary for gathered fields
423    nloc = klon
424    CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
425                    iflag_con, iflag_mix, iflag_ice_thermo, &
426                    iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
427                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
428                    em_p, em_ph, &
429                    Ale, Alp, omega, &
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, &
433                    Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
434                    cape, cin, tvp, &
435                    dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
436                    asupmaxmin, lalim_conv, &
437!AC!+!RomP+jyg
438!!                   da,phi,mp,phii,d1a,dam,sij,clw,elij, &               ! RomP
439!!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
440                    da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
441                    qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
442                    wdtrainA, wdtrainS, wdtrainM, qtc, sigt, &
443                    tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
444!AC!+!RomP+jyg
445                    epmax_diag) ! epmax_cape
446  END IF
447! ------------------------------------------------------------------
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)
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
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
476  IF (iflag_con==30) THEN
477    DO itra = 1, ntra
478      DO k = 1, klev
479        DO i = 1, klon
480!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
481          d_tra(i, k, itra) = 0.
482        END DO
483      END DO
484    END DO
485  END IF
486
487!!AC!
488  IF (iflag_con==3) THEN
489    DO itra = 1, ntra
490      DO k = 1, klev
491        DO i = 1, klon
492!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
493          d_tra(i, k, itra) = 0.
494        END DO
495      END DO
496    END DO
497  END IF
498!!AC!
499
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
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
526
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
538
539
540! les traceurs ne sont pas mis dans cette version de convect4:
541  IF (iflag_con==4) THEN
542    DO itra = 1, ntra
543      DO k = 1, klev
544        DO i = 1, klon
545          d_tra(i, k, itra) = 0.
546        END DO
547      END DO
548    END DO
549  END IF
550! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
551
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
562
563  IF (prt_level>=20) THEN
564    DO k = 1, klev
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)
586    END DO
587  END IF !(prt_level.EQ.20) THEN
588
589  RETURN
590END SUBROUTINE concvl
591
Note: See TracBrowser for help on using the repository browser.