source: LMDZ5/trunk/libf/phylmd/fisrtilp.F90 @ 2807

Last change on this file since 2807 was 2807, checked in by jyg, 8 years ago

Various corrections in fisrtilp.F90 yielding an
energy conserving scheme. Energy is conserved
provided: fl_cor_ebil>0, ok_bad_ecmwf_thermo=n
and iflag_bergeron=2

  • 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: 53.7 KB
Line 
1!
2! $Id: fisrtilp.F90 2807 2017-03-05 23:10:54Z jyg $
3!
4!
5SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, &
6     d_t, d_q, d_ql, d_qi, rneb, radliq, rain, snow,          &
7     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
8     frac_impa, frac_nucl, beta,                        &
9     prfl, psfl, rhcl, zqta, fraca,                     &
10     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
11     iflag_ice_thermo)
12
13  !
14  USE dimphy
15  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
16  USE print_control_mod, ONLY: prt_level, lunout
17  USE cloudth_mod
18  USE ioipsl_getin_p_mod, ONLY : getin_p
19  USE phys_local_var_mod, ONLY: ql_seri,qs_seri
20  ! flag to include modifications to ensure energy conservation (if flag >0)
21  USE add_phys_tend_mod, only : fl_cor_ebil
22  IMPLICIT none
23  !======================================================================
24  ! Auteur(s): Z.X. Li (LMD/CNRS)
25  ! Date: le 20 mars 1995
26  ! Objet: condensation et precipitation stratiforme.
27  !        schema de nuage
28  ! Fusion de fisrt (physique sursaturation, P. LeVan K. Laval)
29  !             et ilp (il pleut, L. Li)
30  ! Principales parties:
31  ! P0> Thermalisation des precipitations venant de la couche du dessus
32  ! P1> Evaporation de la precipitation (qui vient du niveau k+1)
33  ! P2> Formation du nuage (en k)
34  ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
35  ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour
36  ! les valeurs de T et Q initiales
37  ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
38  ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
39  ! P2.B> Nuage "tout ou rien"
40  ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
41  ! P3> Formation de la precipitation (en k)
42  !======================================================================
43  ! JLD:
44  ! * Routine probablement fausse (au moins incoherente) si thermcep = .false.
45  ! * fl_cor_ebil doit etre > 0 ;
46  !   fl_cor_ebil= 0 pour reproduire anciens bugs
47  !======================================================================
48  include "YOMCST.h"
49  include "fisrtilp.h"
50  include "nuage.h" ! JBM (3/14)
51
52  !
53  ! Principaux inputs:
54  !
55  REAL dtime ! intervalle du temps (s)
56  REAL paprs(klon,klev+1) ! pression a inter-couche
57  REAL pplay(klon,klev) ! pression au milieu de couche
58  REAL t(klon,klev) ! temperature (K)
59  REAL q(klon,klev) ! humidite specifique (kg/kg)
60  !
61  ! Principaux outputs:
62  !
63  REAL d_t(klon,klev) ! incrementation de la temperature (K)
64  REAL d_q(klon,klev) ! incrementation de la vapeur d'eau
65  REAL d_ql(klon,klev) ! incrementation de l'eau liquide
66  REAL d_qi(klon,klev) ! incrementation de l'eau glace
67  REAL rneb(klon,klev) ! fraction nuageuse
68  REAL radliq(klon,klev) ! eau liquide utilisee dans rayonnements
69  REAL rhcl(klon,klev) ! humidite relative en ciel clair
70  REAL rain(klon) ! pluies (mm/s)
71  REAL snow(klon) ! neige (mm/s)
72  REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
73  REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
74  !
75  ! Autres arguments
76  !
77  REAL ztv(klon,klev)
78  REAL zqta(klon,klev),fraca(klon,klev)
79  REAL sigma1(klon,klev),sigma2(klon,klev)
80  REAL qltot(klon,klev),ctot(klon,klev)
81  REAL zpspsk(klon,klev),ztla(klon,klev)
82  REAL zthl(klon,klev)
83  REAL ztfondue, qsl, qsi
84
85  logical lognormale(klon)
86  logical ice_thermo
87
88  !AA
89  ! Coeffients de fraction lessivee : pour OFF-LINE
90  !
91  REAL pfrac_nucl(klon,klev)
92  REAL pfrac_1nucl(klon,klev)
93  REAL pfrac_impa(klon,klev)
94  !
95  ! Fraction d'aerosols lessivee par impaction et par nucleation
96  ! POur ON-LINE
97  !
98  REAL frac_impa(klon,klev)
99  REAL frac_nucl(klon,klev)
100  real zct      ,zcl
101  !AA
102  !
103  ! Options du programme:
104  !
105  REAL seuil_neb ! un nuage existe vraiment au-dela
106  PARAMETER (seuil_neb=0.001)
107
108  INTEGER ninter ! sous-intervals pour la precipitation
109  INTEGER ncoreczq 
110  INTEGER iflag_cld_th
111  INTEGER iflag_ice_thermo
112  PARAMETER (ninter=5)
113  LOGICAL evap_prec ! evaporation de la pluie
114  PARAMETER (evap_prec=.TRUE.)
115  REAL ratqs(klon,klev) ! determine la largeur de distribution de vapeur
116  logical ptconv(klon,klev) ! determine la largeur de distribution de vapeur
117
118  real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
119  real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
120  real erf   
121  REAL qcloud(klon)
122  !
123  LOGICAL cpartiel ! condensation partielle
124  PARAMETER (cpartiel=.TRUE.)
125  REAL t_coup
126  PARAMETER (t_coup=234.0)
127  !
128  ! Variables locales:
129  !
130  INTEGER i, k, n, kk
131  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5 
132  REAL zdqsdT_raw(klon)
133  REAL Tbef(klon),qlbef(klon),DT(klon),num,denom
134  LOGICAL convergence(klon)
135  REAL DDT0
136  PARAMETER (DDT0=.01)
137  INTEGER n_i(klon), iter
138  REAL cste
139 
140  REAL zrfl(klon), zrfln(klon), zqev, zqevt
141  REAL zifl(klon), zifln(klon), zqev0,zqevi, zqevti
142  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
143  REAL zoliqp(klon), zoliqi(klon)
144  REAL zt(klon)
145! JBM (3/14) nexpo is replaced by exposant_glace
146! REAL nexpo ! exponentiel pour glace/eau
147! INTEGER, PARAMETER :: nexpo=6
148  INTEGER exposant_glace_old
149  REAL t_glace_min_old
150  REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
151  REAL zchau      ,zfroi      ,zfice(klon),zneb(klon)
152  REAL zmelt, zpluie, zice, zcondold
153  PARAMETER (ztfondue=278.15)
154  REAL dzfice(klon)
155  REAL zsolid
156!!!!
157!  Variables pour Bergeron
158  REAL zcp, coef1, DeltaT, Deltaq, Deltaqprecl
159  REAL zqpreci(klon), zqprecl(klon)
160! Variable pour conservation enegie des precipitations
161  REAL zmqc(klon)
162  !
163  LOGICAL appel1er
164  SAVE appel1er
165  !$OMP THREADPRIVATE(appel1er)
166  !
167! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
168! iflag_oldbug_fisrtilp=1 ajoute le BUG
169  INTEGER,SAVE :: iflag_oldbug_fisrtilp=0 !=0 sans bug
170  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp)
171  !---------------------------------------------------------------
172  !
173  !AA Variables traceurs:
174  !AA  Provisoire !!! Parametres alpha du lessivage
175  !AA  A priori on a 4 scavenging # possibles
176  !
177  REAL a_tr_sca(4)
178  save a_tr_sca
179  !$OMP THREADPRIVATE(a_tr_sca)
180  !
181  ! Variables intermediaires
182  !
183  REAL zalpha_tr
184  REAL zfrac_lessi
185  REAL zprec_cond(klon)
186  !AA
187! RomP >>> 15 nov 2012
188  REAL   beta(klon,klev) ! taux de conversion de l'eau cond
189! RomP <<<
190  REAL zmair(klon), zcpair, zcpeau
191  !     Pour la conversion eau-neige
192  REAL zlh_solid(klon), zm_solid
193  !---------------------------------------------------------------
194  !
195  ! Fonctions en ligne:
196  !
197  REAL fallvs,fallvc ! Vitesse de chute pour cristaux de glace
198                     ! (Heymsfield & Donner, 1990)
199  REAL zzz
200
201  include "YOETHF.h"
202  include "FCTTRE.h"
203  fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
204  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
205  !
206  DATA appel1er /.TRUE./
207  !ym
208!CR: pour iflag_ice_thermo=2, on active que la convection
209!  ice_thermo = iflag_ice_thermo .GE. 1
210   ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
211  zdelq=0.0
212
213  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
214  IF (appel1er) THEN
215     CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
216     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp
217     !
218     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
219     WRITE(lunout,*) 'fisrtilp, evap_prec:', evap_prec
220     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
221     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
222        WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
223        WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
224        !         CALL abort
225     ENDIF
226     appel1er = .FALSE.
227     !
228     !AA initialiation provisoire
229     a_tr_sca(1) = -0.5
230     a_tr_sca(2) = -0.5
231     a_tr_sca(3) = -0.5
232     a_tr_sca(4) = -0.5
233     !
234     !AA Initialisation a 1 des coefs des fractions lessivees
235     !
236     !cdir collapse
237     DO k = 1, klev
238        DO i = 1, klon
239           pfrac_nucl(i,k)=1.
240           pfrac_1nucl(i,k)=1.
241           pfrac_impa(i,k)=1.
242           beta(i,k)=0.  !RomP initialisation
243        ENDDO
244     ENDDO
245
246  ENDIF          !  test sur appel1er
247  !
248  !MAf Initialisation a 0 de zoliq
249  !      DO i = 1, klon
250  !         zoliq(i)=0.
251  !      ENDDO
252  ! Determiner les nuages froids par leur temperature
253  !  nexpo regle la raideur de la transition eau liquide / eau glace.
254  !
255!CR: on est oblige de definir des valeurs fisrt car les valeurs de newmicro ne sont pas les memes par defaut
256  IF (iflag_t_glace.EQ.0) THEN
257!   ztglace = RTT - 15.0
258    t_glace_min_old = RTT - 15.0
259    !AJ<
260    IF (ice_thermo) THEN
261!     nexpo = 2
262      exposant_glace_old = 2
263    ELSE
264!     nexpo = 6
265      exposant_glace_old = 6
266    ENDIF
267   
268  ENDIF
269 
270!!  RLVTT = 2.501e6 ! pas de redefinition des constantes physiques (jyg)
271!!  RLSTT = 2.834e6 ! pas de redefinition des constantes physiques (jyg)
272!>AJ
273  !cc      nexpo = 1
274  !
275  ! Initialiser les sorties:
276  !
277  !cdir collapse
278  DO k = 1, klev+1
279     DO i = 1, klon
280        prfl(i,k) = 0.0
281        psfl(i,k) = 0.0
282     ENDDO
283  ENDDO
284
285  !cdir collapse
286  DO k = 1, klev
287     DO i = 1, klon
288        d_t(i,k) = 0.0
289        d_q(i,k) = 0.0
290        d_ql(i,k) = 0.0
291        d_qi(i,k) = 0.0
292        rneb(i,k) = 0.0
293        radliq(i,k) = 0.0
294        frac_nucl(i,k) = 1.
295        frac_impa(i,k) = 1.
296     ENDDO
297  ENDDO
298  DO i = 1, klon
299     rain(i) = 0.0
300     snow(i) = 0.0
301     zoliq(i)=0.
302     !     ENDDO
303     !
304     ! Initialiser le flux de precipitation a zero
305     !
306     !     DO i = 1, klon
307     zrfl(i) = 0.0
308     zifl(i) = 0.0
309     zneb(i) = seuil_neb
310  ENDDO
311  !
312  !
313  !AA Pour plus de securite
314
315  zalpha_tr   = 0.
316  zfrac_lessi = 0.
317
318  !AA==================================================================
319  !
320  ncoreczq=0
321  ! BOUCLE VERTICALE (DU HAUT VERS LE BAS)
322  !
323  DO k = klev, 1, -1
324     !
325     !AA===============================================================
326     !
327     ! Initialisation temperature et vapeur
328     DO i = 1, klon
329        zt(i)=t(i,k)
330        zq(i)=q(i,k)
331     ENDDO
332     !
333     ! ----------------------------------------------------------------
334     ! P0> Thermalisation des precipitations venant de la couche du dessus
335     ! ----------------------------------------------------------------
336     ! Calculer la varition de temp. de l'air du a la chaleur sensible
337     ! transporter par la pluie. On thermalise la pluie avec l'air de la couche.
338     ! Cette quantite de pluie qui est thermalisee, et devra continue a l'etre lors
339     ! des differentes transformations thermodynamiques. Cette masse d'eau doit
340     ! donc etre ajoute a l'humidite de la couche lorsque l'on calcule la variation
341     ! de l'enthalpie  de la couche avec la temperature
342     ! Variables calculees ou modifiees:
343     !   -  zt: temperature de la cocuhe
344     !   - zmqc: masse de precip qui doit etre thermalisee
345     !
346     IF(k.LE.klevm1) THEN         
347        DO i = 1, klon
348           !IM
349           zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
350           ! il n'y a pas encore d'eau liquide ni glace dans la maiille, donc zq suffit
351           zcpair=RCPD*(1.0+RVTMP2*zq(i))
352           zcpeau=RCPD*RVTMP2
353         if (fl_cor_ebil .GT. 0) then
354           ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm
355           ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la
356           ! derniere couche
357           zmqc(i) = (zrfl(i)+zifl(i))*dtime/zmair(i)
358           ! t(i,k+1)+d_t(i,k+1): nouvelle temp de la couche au dessus
359           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zmqc(i)*zcpeau + zcpair*zt(i) ) &
360                 / (zcpair + zmqc(i)*zcpeau)
361         else ! si on maintient les anciennes erreurs
362           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau &
363                + zmair(i)*zcpair*zt(i) ) &
364                / (zmair(i)*zcpair + zrfl(i)*dtime*zcpeau)
365         end if
366        ENDDO
367     ENDIF ! end IF(k.LE.klevm1)
368     !
369     ! ----------------------------------------------------------------
370     ! P1> Calcul de l'evaporation de la precipitation
371     ! ----------------------------------------------------------------
372     ! On evapore une partie des precipitations venant de la maille du dessus.
373     ! On calcule l'evaporation et la sublimation des precipitations, jusqu'a
374     ! ce que la fraction de cette couche qui est sous le nuage soit saturee.
375     ! Variables calculees ou modifiees:
376     !   - zrfl et zifl: flux de precip liquide et glace
377     !   - zq, zt: humidite et temperature de la cocuhe
378     !   - zmqc: masse de precip qui doit etre thermalisee
379     !
380     IF (evap_prec) THEN
381        DO i = 1, klon
382!          S'il y a des precipitations
383           IF (zrfl(i)+zifl(i).GT.0.) THEN
384              ! Calcul du qsat
385              IF (thermcep) THEN
386                 zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
387                 zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
388                 zqs(i)=MIN(0.5,zqs(i))
389                 zcor=1./(1.-RETV*zqs(i))
390                 zqs(i)=zqs(i)*zcor
391              ELSE
392                 IF (zt(i) .LT. t_coup) THEN
393                    zqs(i) = qsats(zt(i)) / pplay(i,k)
394                 ELSE
395                    zqs(i) = qsatl(zt(i)) / pplay(i,k)
396                 ENDIF
397              ENDIF
398           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
399        ENDDO
400!AJ<
401
402       IF (.NOT. ice_thermo) THEN
403        DO i = 1, klon
404!          S'il y a des precipitations
405           IF (zrfl(i)+zifl(i).GT.0.) THEN
406                ! Evap max pour ne pas saturer la fraction sous le nuage
407                ! Evap max jusqu'à atteindre la saturation dans la partie
408                ! de la maille qui est sous le nuage de la couche du dessus
409                !!! On ne tient compte de cette fraction que sous une seule
410                !!! couche sous le nuage
411                zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
412             ! Ajout de la prise en compte des precip a thermiser
413             ! avec petite reecriture
414             if  (fl_cor_ebil .GT. 0) then ! nouveau
415                ! Calcul de l'evaporation du flux de precip herite
416                !   d'au-dessus
417                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
418                     * zmair(i)/pplay(i,k)*zt(i)*RD
419                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) * dtime/zmair(i)
420
421                ! Seuil pour ne pas saturer la fraction sous le nuage
422                zqev = MIN (zqev, zqevt)
423                ! Nouveau flux de precip
424                zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime
425                ! Aucun flux liquide pour T < t_coup, on reevapore tout.
426                IF (zt(i) .LT. t_coup.and.reevap_ice) THEN
427                  zrfln(i)=0.
428                  zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime
429                END IF
430                ! Nouvelle vapeur
431                zq(i) = zq(i) + zqev
432                zmqc(i) = zmqc(i)-zqev
433                ! Nouvelle temperature (chaleur latente)
434                zt(i) = zt(i) - zqev &
435                     * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
436!!JLD debut de partie a supprimer a therme
437            else ! if  (fl_cor_ebil .GT. 0)
438                ! Calcul de l'evaporation du flux de precip herite
439                !   d'au-dessus
440                zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
441                     * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
442                zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
443                     * RG*dtime/(paprs(i,k)-paprs(i,k+1))
444                ! Seuil pour ne pas saturer la fraction sous le nuage
445                zqev = MIN (zqev, zqevt)
446                ! Nouveau flux de precip
447                zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
448                     /RG/dtime
449                ! Aucun flux liquide pour T < t_coup
450                IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
451                ! Nouvelle vapeur
452                zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
453                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
454                ! Nouvelle temperature (chaleur latente)
455                zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
456                     * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
457                     * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
458              end if ! if  (fl_cor_ebil .GT. 0)
459!!JLD fin de partie a supprimer a therme
460                zrfl(i) = zrfln(i)
461                zifl(i) = 0.
462           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
463        ENDDO
464!
465       ELSE ! (.NOT. ice_thermo)
466!      ================================
467!      Avec thermodynamique de la glace
468!      ================================
469        DO i = 1, klon
470!AJ<
471!        S'il y a des precipitations
472         IF (zrfl(i)+zifl(i).GT.0.) THEN
473     
474        ! Evap max pour ne pas saturer la fraction sous le nuage
475         zqev0 = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
476
477         !JAM
478         ! On differencie qsat pour l'eau et la glace
479         ! Si zdelta=1. --> glace
480         ! Si zdelta=0. --> eau liquide
481       
482         ! Calcul du qsat par rapport a l'eau liquide
483         qsl= R2ES*FOEEW(zt(i),0.)/pplay(i,k)
484         qsl= MIN(0.5,qsl)
485         zcor= 1./(1.-RETV*qsl)
486         qsl= qsl*zcor
487         
488         ! Calcul de l'evaporation du flux de precip venant du dessus
489         ! Formulation en racine du flux de precip
490         ! (Klemp & Wilhelmson, 1978; Sundqvist, 1988)
491         zqevt = 1.*coef_eva*(1.0-zq(i)/qsl)*SQRT(zrfl(i)) &
492              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
493         zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
494              *RG*dtime/(paprs(i,k)-paprs(i,k+1))
495         
496         ! Calcul du qsat par rapport a la glace
497         qsi= R2ES*FOEEW(zt(i),1.)/pplay(i,k)
498         qsi= MIN(0.5,qsi)
499         zcor= 1./(1.-RETV*qsi)
500         qsi= qsi*zcor
501
502         ! Calcul de la sublimation du flux de precip solide herite
503         !   d'au-dessus
504         zqevti = 1.*coef_eva*(1.0-zq(i)/qsi)*SQRT(zifl(i)) &
505              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
506         zqevti = MAX(0.0,MIN(zqevti,zifl(i))) &
507              *RG*dtime/(paprs(i,k)-paprs(i,k+1))   
508
509        !JAM
510        ! Limitation de l'evaporation. On s'assure qu'on ne sature pas
511        ! la fraction de la couche sous le nuage sinon on repartit zqev0
512        ! en conservant la proportion liquide / glace
513     
514         IF (zqevt+zqevti.GT.zqev0) THEN
515            zqev=zqev0*zqevt/(zqevt+zqevti)
516            zqevi=zqev0*zqevti/(zqevt+zqevti)
517         ELSE
518!JLD je ne comprends pas les lignes ci-dessous. On repartit les precips
519!       liquides et solides meme si on ne sature pas la couche.
520!       A mon avis, le test est inutile, et il faudrait tout remplacer par:
521!            zqev=zqevt
522!            zqevi=zqevti
523             IF (zqevt+zqevti.GT.0.) THEN
524                zqev=MIN(zqev0*zqevt/(zqevt+zqevti),zqevt)
525                zqevi=MIN(zqev0*zqevti/(zqevt+zqevti),zqevti)
526             ELSE
527             zqev=0.
528             zqevi=0.
529             ENDIF
530         ENDIF
531         ! Nouveaux flux de precip liquide et solide
532         zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
533                                 /RG/dtime)
534         zifln(i) = Max(0.,zifl(i) - zqevi*(paprs(i,k)-paprs(i,k+1)) &
535                                 /RG/dtime)
536
537         ! Mise a jour de la vapeur, temperature et flux de precip
538         zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
539                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
540       if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
541         zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) &
542                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
543         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
544                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
545                  * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) &
546                  + (zifln(i)-zifl(i)) &
547                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
548                  * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
549       else ! sans correction thermalisation des precips
550         zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
551                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
552                  * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
553                  + (zifln(i)-zifl(i)) &
554                  * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
555                  * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
556       end if
557        ! Nouvelles vaeleurs des precips liquides et solides
558         zrfl(i) = zrfln(i)
559         zifl(i) = zifln(i)
560
561!CR ATTENTION: deplacement de la fonte de la glace
562!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
563!!!        zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2  !!!!!!!!! jyg
564!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
565           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))             ! jyg
566           ! fraction de la precip solide qui est fondue
567           zmelt = MIN(MAX(zmelt,0.),1.)
568           ! Fusion de la glace
569           zrfl(i)=zrfl(i)+zmelt*zifl(i)
570           if (fl_cor_ebil .LE. 0) then
571             ! the following line should not be here. Indeed, if zifl is modified
572             ! now, zifl(i)*zmelt is no more the amount of ice that has melt
573             ! and therefore the change in temperature computed below is wrong
574             zifl(i)=zifl(i)*(1.-zmelt)
575           end if
576           ! Chaleur latente de fusion
577        if (fl_cor_ebil .GT. 0) then ! avec correction thermalisation des precips
578           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
579                      *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
580        else ! sans correction thermalisation des precips
581           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
582                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
583        end if
584           if (fl_cor_ebil .GT. 0) then ! correction bug, deplacement ligne precedente
585             zifl(i)=zifl(i)*(1.-zmelt)
586           end if
587
588           ENDIF ! (zrfl(i)+zifl(i).GT.0.)
589        ENDDO
590
591      ENDIF ! (.NOT. ice_thermo)
592     
593     ! ----------------------------------------------------------------
594     ! Fin evaporation de la precipitation
595     ! ----------------------------------------------------------------
596     ENDIF ! (evap_prec)
597     !
598     ! Calculer Qs et L/Cp*dQs/dT:
599     !
600     IF (thermcep) THEN
601        DO i = 1, klon
602           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
603           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
604       if  (fl_cor_ebil .GT. 0) then ! nouveau
605           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
606       else   
607           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
608       endif
609           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
610           zqs(i) = MIN(0.5,zqs(i))
611           zcor = 1./(1.-RETV*zqs(i))
612           zqs(i) = zqs(i)*zcor
613           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
614           zdqsdT_raw(i) = zdqs(i)*  &
615         &         RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
616        ENDDO
617     ELSE
618        DO i = 1, klon
619           IF (zt(i).LT.t_coup) THEN
620              zqs(i) = qsats(zt(i))/pplay(i,k)
621              zdqs(i) = dqsats(zt(i),zqs(i))
622           ELSE
623              zqs(i) = qsatl(zt(i))/pplay(i,k)
624              zdqs(i) = dqsatl(zt(i),zqs(i))
625           ENDIF
626        ENDDO
627     ENDIF
628     !
629     ! Determiner la condensation partielle et calculer la quantite
630     ! de l'eau condensee:
631     !
632!verification de la valeur de iflag_fisrtilp_qsat pour iflag_ice_thermo=1
633!       if ((iflag_ice_thermo.eq.1).and.(iflag_fisrtilp_qsat.ne.0)) then
634!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
635!        " but iflag_fisrtilp_qsat=",iflag_fisrtilp_qsat, ". Might as well stop here."
636!         stop
637!       endif
638
639     ! ----------------------------------------------------------------
640     ! P2> Formation du nuage
641     ! ----------------------------------------------------------------
642     ! Variables calculees:
643     !   rneb  : fraction nuageuse
644     !   zcond : eau condensee moyenne dans la maille.
645     !   rhcl: humidite relative ciel-clair
646     !   zt : temperature de la maille
647     ! ----------------------------------------------------------------
648     !
649     IF (cpartiel) THEN
650        ! -------------------------
651        ! P2.A> Nuage fractionnaire
652        ! -------------------------
653        !
654        !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
655        !   nuageuse a partir des PDF de Sandrine Bony.
656        !   rneb  : fraction nuageuse
657        !   zqn   : eau totale dans le nuage
658        !   zcond : eau condensee moyenne dans la maille.
659        !  on prend en compte le réchauffement qui diminue la partie
660        ! condensee
661        !
662        !   Version avec les raqts
663
664        ! ----------------------------------------------------------------
665        ! P2.A.0> Calcul des grandeurs nuageuses une pdf en creneau
666        ! ----------------------------------------------------------------
667        if (iflag_pdf.eq.0) then
668
669           ! version creneau de (Li, 1998)
670           do i=1,klon
671              zdelq = min(ratqs(i,k),0.99) * zq(i)
672              rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
673              zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
674           enddo
675
676        else !  if (iflag_pdf.eq.0)
677           ! ----------------------------------------------------------------
678           ! P2.A.1> Avec les nouvelles PDFs, calcul des grandeurs nuageuses pour
679           ! les valeurs de T et Q initiales
680           ! ----------------------------------------------------------------
681           do i=1,klon
682              if(zq(i).lt.1.e-15) then
683                 ncoreczq=ncoreczq+1
684                 zq(i)=1.e-15
685              endif
686           enddo
687
688           if (iflag_cld_th>=5) then
689
690              if (iflag_cloudth_vert<=2) then
691               call cloudth(klon,klev,k,ztv, &
692                   zq,zqta,fraca, &
693                   qcloud,ctot,zpspsk,paprs,ztla,zthl, &
694                   ratqs,zqs,t)
695              elseif (iflag_cloudth_vert==3) then
696               call cloudth_v3(klon,klev,k,ztv, &
697                   zq,zqta,fraca, &
698                   qcloud,ctot,zpspsk,paprs,ztla,zthl, &
699                   ratqs,zqs,t)
700              endif
701              do i=1,klon
702                 rneb(i,k)=ctot(i,k)
703                 zqn(i)=qcloud(i)
704              enddo
705
706           endif
707
708           if (iflag_cld_th <= 4) then
709              lognormale = .true.
710           elseif (iflag_cld_th >= 6) then
711              ! lognormale en l'absence des thermiques
712              lognormale = fraca(:,k) < 1e-10
713           else
714              ! Dans le cas iflag_cld_th=5, on prend systématiquement la
715              ! bi-gaussienne
716              lognormale = .false.
717           end if
718
719!CR: variation de qsat avec T en presence de glace ou non
720!initialisations
721           do i=1,klon
722              DT(i) = 0.
723              n_i(i)=0
724              Tbef(i)=zt(i)
725              qlbef(i)=0.
726           enddo
727
728        ! ----------------------------------------------------------------
729        ! P2.A.2> Prise en compte du couplage entre eau condensee et T.
730        ! Calcul des grandeurs nuageuses en tenant compte de l'effet de
731        ! la condensation sur T, et donc sur qsat et sur les grandeurs nuageuses
732        ! qui en dependent. Ce changement de temperature est provisoire, et
733        ! la valeur definitive sera calcule plus tard.
734        ! Variables calculees:
735        !   rneb : nebulosite
736        !   zcond: eau condensee en moyenne dans la maille
737        ! note JLD: si on n'a pas de pdf lognormale, ce qui se passe ne me semble
738        ! pas clair, il n'y a probablement pas de prise en compte de l'effet de
739        ! T sur qsat
740        ! ----------------------------------------------------------------
741
742!Boucle iterative: ATTENTION, l'option -1 n'est plus activable ici
743           if (iflag_fisrtilp_qsat.ge.0) then
744             ! Iteration pour condensation avec variation de qsat(T)
745             ! -----------------------------------------------------
746             do iter=1,iflag_fisrtilp_qsat+1
747               
748               do i=1,klon
749!                 do while ((abs(DT(i)).gt.DDT0).or.(n_i(i).eq.0))
750                 ! !! convergence = .true. tant que l'on n'a pas converge !!
751                 ! ------------------------------
752                 convergence(i)=abs(DT(i)).gt.DDT0
753                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
754                 ! si on n'a pas converge
755                 !
756                 ! P2.A.2.1> Calcul de la fraction nuageuse et de la quantite d'eau condensee
757                 ! ---------------------------------------------------------------
758                 ! Variables calculees:
759                 ! rneb : nebulosite
760                 ! zqn : eau condensee, dans le nuage (in cloud water content)
761                 ! zcond: eau condensee en moyenne dans la maille
762                 ! rhcl: humidite relative ciel-clair
763                 !
764                 Tbef(i)=Tbef(i)+DT(i) ! nouvelle temperature
765                 if (.not.ice_thermo) then   
766                    zdelta = MAX(0.,SIGN(1.,RTT-Tbef(i)))
767                 else
768                    if (iflag_t_glace.eq.0) then
769                    zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
770                    else if (iflag_t_glace.ge.1) then
771                       if (iflag_oldbug_fisrtilp.EQ.0) then
772                          zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
773                       else
774                          !avec bug : zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
775                          zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
776                       endif
777                    endif
778                 endif
779                 ! Calcul de rneb, qzn et zcond pour les PDF lognormales
780                 zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
781               if (fl_cor_ebil .GT. 0) then
782                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
783               else
784                 zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
785               end if
786                 zqs(i) = R2ES*FOEEW(Tbef(i),zdelta)/pplay(i,k)
787                 zqs(i) = MIN(0.5,zqs(i))
788                 zcor = 1./(1.-RETV*zqs(i))
789                 zqs(i) = zqs(i)*zcor
790                 zdqs(i) = FOEDE(Tbef(i),zdelta,zcvm5,zqs(i),zcor)
791                 zpdf_sig(i)=ratqs(i,k)*zq(i)
792                 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
793                 zpdf_delta(i)=log(zq(i)/zqs(i))
794                 zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
795                 zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
796                 zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
797                 zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
798                 zpdf_e1(i)=1.-erf(zpdf_e1(i))
799                 zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
800                 zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
801                 zpdf_e2(i)=1.-erf(zpdf_e2(i))
802             
803                 if (zpdf_e1(i).lt.1.e-10) then
804                    rneb(i,k)=0.
805                    zqn(i)=zqs(i)
806                 else
807                    rneb(i,k)=0.5*zpdf_e1(i)
808                    zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
809                 endif
810
811                 endif !convergence
812               enddo ! boucle en i
813
814                 ! P2.A.2.2> Calcul APPROCHE de la variation de temperature DT
815                 !         due a la condensation.
816                 ! ---------------------------------------------------------------
817                 ! Variables calculees:
818                 ! DT : variation de temperature due a la condensation
819
820                 if (.not. ice_thermo) then
821                 ! --------------------------
822                 do i=1,klon
823                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
824
825                 qlbef(i)=max(0.,zqn(i)-zqs(i))
826               if (fl_cor_ebil .GT. 0) then
827                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
828               else
829                 num=-Tbef(i)+zt(i)+rneb(i,k)*RLVTT/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
830               end if
831                 denom=1.+rneb(i,k)*zdqs(i)
832                 DT(i)=num/denom
833                 n_i(i)=n_i(i)+1
834                 endif
835                 enddo
836
837                 else ! if (.not. ice_thermo)
838                 ! --------------------------
839                 if (iflag_t_glace.ge.1) then
840                 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
841                 endif
842
843                 do i=1,klon
844                 if ((convergence(i).or.(n_i(i).eq.0)).and.lognormale(i)) then
845                 
846                 if (iflag_t_glace.eq.0) then
847                    zfice(i) = 1.0 - (Tbef(i)-t_glace_min_old) / (RTT-t_glace_min_old)
848                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
849                    zfice(i) = zfice(i)**exposant_glace_old
850                    dzfice(i)= exposant_glace_old * zfice(i)**(exposant_glace_old-1) &
851          &                     / (t_glace_min_old - RTT)
852                 endif
853                 
854                 if (iflag_t_glace.ge.1) then
855                 dzfice(i)= exposant_glace * zfice(i)**(exposant_glace-1) &
856          &                    / (t_glace_min - t_glace_max)
857                 endif
858               
859                 if ((zfice(i).eq.0).or.(zfice(i).eq.1)) then
860                    dzfice(i)=0.
861                 endif
862
863                 if (zfice(i).lt.1) then
864                    cste=RLVTT
865                 else
866                    cste=RLSTT
867                 endif
868
869                 qlbef(i)=max(0.,zqn(i)-zqs(i))
870               if (fl_cor_ebil .GT. 0) then
871                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
872           &          +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*qlbef(i)
873                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
874                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))*rneb(i,k)    &
875           &               *qlbef(i)*dzfice(i)
876               else
877                 num = -Tbef(i)+zt(i)+rneb(i,k)*((1-zfice(i))*RLVTT &
878           &         +zfice(i)*RLSTT)/RCPD/(1.0+RVTMP2*zq(i))*qlbef(i)
879                 denom = 1.+rneb(i,k)*((1-zfice(i))*RLVTT+zfice(i)*RLSTT)/cste*zdqs(i) &
880                         -(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))*rneb(i,k)*qlbef(i)*dzfice(i)
881               end if
882                 DT(i)=num/denom
883                 n_i(i)=n_i(i)+1
884
885                 endif ! fin convergence
886                 enddo ! fin boucle i
887
888                 endif !ice_thermo
889
890             enddo ! iter=1,iflag_fisrtilp_qsat+1
891             ! Fin d'iteration pour condensation avec variation de qsat(T)
892             ! -----------------------------------------------------------
893           endif !  if (iflag_fisrtilp_qsat.ge.0)
894     ! ----------------------------------------------------------------
895     ! Fin de P2.A.2> la prise en compte du couplage entre eau condensee et T
896     ! ----------------------------------------------------------------
897
898        endif ! iflag_pdf
899
900!        if (iflag_fisrtilp_qsat.eq.-1) then
901!------------------------------------------
902!CR: ATTENTION option fausse mais a existe:
903! pour la re-activer, prendre iflag_fisrtilp_qsat=0 et
904! activer les lignes suivantes:
905       IF (1.eq.0) THEN
906       DO i=1,klon
907           IF (rneb(i,k) .LE. 0.0) THEN
908              zqn(i) = 0.0
909              rneb(i,k) = 0.0
910              zcond(i) = 0.0
911              rhcl(i,k)=zq(i)/zqs(i)
912           ELSE IF (rneb(i,k) .GE. 1.0) THEN
913              zqn(i) = zq(i)
914              rneb(i,k) = 1.0                 
915              zcond(i) = MAX(0.0,zqn(i)-zqs(i))/(1+zdqs(i))
916              rhcl(i,k)=1.0
917           ELSE
918              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1+zdqs(i))
919              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
920           ENDIF
921       ENDDO
922       ENDIF
923!------------------------------------------
924
925!        ELSE
926        ! ----------------------------------------------------------------
927        ! P2.A.3> Calcul des valeures finales associees a la formation des nuages
928        ! Variables calculees:
929        !   rneb : nebulosite
930        !   zcond: eau condensee en moyenne dans la maille
931        !   zq : eau vapeur dans la maille
932        !   zt : temperature de la maille
933        !   rhcl: humidite relative ciel-clair
934        ! ----------------------------------------------------------------
935        !
936        ! Bornage de l'eau in-cloud (zqn) et de la fraction nuageuse (rneb)
937        ! Calcule de l'eau condensee moyenne dans la maille (zcond),
938        ! et de l'humidite relative ciel-clair (rhcl)
939        DO i=1,klon
940           IF (rneb(i,k) .LE. 0.0) THEN
941              zqn(i) = 0.0
942              rneb(i,k) = 0.0
943              zcond(i) = 0.0
944              rhcl(i,k)=zq(i)/zqs(i)
945           ELSE IF (rneb(i,k) .GE. 1.0) THEN
946              zqn(i) = zq(i)
947              rneb(i,k) = 1.0
948              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
949              rhcl(i,k)=1.0
950           ELSE
951              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
952              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
953           ENDIF
954        ENDDO
955
956!        ENDIF
957
958     ELSE ! de IF (cpartiel)
959        ! -------------------------
960        ! P2.B> Nuage "tout ou rien"
961        ! -------------------------
962        ! note JLD: attention, rhcl non calcule. Ca peut avoir des consequences?
963        DO i = 1, klon
964           IF (zq(i).GT.zqs(i)) THEN
965              rneb(i,k) = 1.0
966           ELSE
967              rneb(i,k) = 0.0
968           ENDIF
969           zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
970        ENDDO
971     ENDIF ! de IF (cpartiel)
972     !
973     ! Mise a jour vapeur d'eau
974     ! -------------------------
975     DO i = 1, klon
976        zq(i) = zq(i) - zcond(i)
977        !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
978     ENDDO
979!AJ<
980     ! ------------------------------------
981     ! P2.C> Prise en compte de la Chaleur latente apres formation nuage
982     ! -------------------------------------
983     ! Variable calcule:
984     !   zt : temperature de la maille
985     !
986     IF (.NOT. ice_thermo) THEN
987        if (iflag_fisrtilp_qsat.lt.1) then
988           DO i = 1, klon
989             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
990           ENDDO
991        else if (iflag_fisrtilp_qsat.gt.0) then
992           DO i= 1, klon
993    if (fl_cor_ebil .GT. 0) then
994             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
995    else
996             zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
997    end if
998           ENDDO
999        endif
1000     ELSE
1001         if (iflag_t_glace.ge.1) then
1002            CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
1003         endif
1004         if (iflag_fisrtilp_qsat.lt.1) then
1005           DO i = 1, klon
1006! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
1007!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
1008!                                     t_glace_max, exposant_glace)
1009              if (iflag_t_glace.eq.0) then
1010                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
1011                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
1012                    zfice(i) = zfice(i)**exposant_glace_old
1013              endif
1014              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
1015                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
1016           ENDDO
1017         else
1018           DO i=1, klon
1019! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
1020!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
1021!                                     t_glace_max, exposant_glace)
1022              if (iflag_t_glace.eq.0) then
1023                    zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (RTT-t_glace_min_old)
1024                    zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
1025                    zfice(i) = zfice(i)**exposant_glace_old
1026              endif
1027        if (fl_cor_ebil .GT. 0) then
1028              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) &
1029           &             * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i))) &
1030                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
1031        else
1032              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
1033                      +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
1034        end if
1035           ENDDO
1036         endif
1037!         print*,zt(i),zrfl(i),zifl(i),'temp1'
1038       ENDIF
1039!>AJ
1040
1041     ! ----------------------------------------------------------------
1042     ! P3> Formation des precipitations
1043     ! ----------------------------------------------------------------
1044     !
1045     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
1046     !
1047
1048     ! Initialisation de zoliq (eau condensee moyenne dans la maille)
1049     DO i = 1, klon
1050        IF (rneb(i,k).GT.0.0) THEN
1051           zoliq(i) = zcond(i)
1052           zrho(i) = pplay(i,k) / zt(i) / RD
1053           zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
1054        ENDIF
1055     ENDDO
1056!AJ<
1057     IF (.NOT. ice_thermo) THEN
1058       IF (iflag_t_glace.EQ.0) THEN
1059         DO i = 1, klon
1060            IF (rneb(i,k).GT.0.0) THEN
1061               zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.13-t_glace_min_old)
1062               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
1063               zfice(i) = zfice(i)**exposant_glace_old
1064!              zfice(i) = zfice(i)**nexpo
1065         !!      zfice(i)=0.
1066            ENDIF
1067         ENDDO
1068       ELSE ! of IF (iflag_t_glace.EQ.0)
1069         CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
1070!         DO i = 1, klon
1071!            IF (rneb(i,k).GT.0.0) THEN
1072! JBM: icefrac_lsc is now a function contained in icefrac_lsc_mod
1073!              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
1074!                                     t_glace_max, exposant_glace)
1075!            ENDIF
1076!         ENDDO
1077       ENDIF
1078     ENDIF
1079
1080     ! Calcul de radliq (eau condensee pour le rayonnement)
1081     ! Iteration pour realiser une moyenne de l'eau nuageuse lors de la precip
1082     ! Remarque: ce n'est donc pas l'eau restante en fin de precip mais une
1083     ! eau moyenne restante dans le nuage sur la duree du pas de temps qui est
1084     ! transmise au rayonnement;
1085     ! ----------------------------------------------------------------
1086     DO i = 1, klon
1087        IF (rneb(i,k).GT.0.0) THEN
1088           zneb(i) = MAX(rneb(i,k), seuil_neb)
1089     !      zt(i) = zt(i)+zcond(i)*zfice(i)*RLMLT/RCPD/(1.0+RVTMP2*zq(i)) 
1090!           print*,zt(i),'fractionglace'
1091!>AJ
1092           radliq(i,k) = zoliq(i)/REAL(ninter+1)
1093        ENDIF
1094     ENDDO
1095     !
1096     DO n = 1, ninter
1097        DO i = 1, klon
1098           IF (rneb(i,k).GT.0.0) THEN
1099              zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
1100              ! Initialization of zpluie and zice:
1101              zpluie=0
1102              zice=0
1103              IF (zneb(i).EQ.seuil_neb) THEN
1104                 ztot = 0.0
1105              ELSE
1106                 !  quantite d'eau a eliminer: zchau (Sundqvist, 1978)
1107                 !  meme chose pour la glace: zfroi (Zender & Kiehl, 1997)
1108                 if (ptconv(i,k)) then
1109                    zcl   =cld_lc_con
1110                    zct   =1./cld_tau_con
1111                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
1112                         *fallvc(zrhol(i)) * zfice(i)
1113                 else
1114                    zcl   =cld_lc_lsc
1115                    zct   =1./cld_tau_lsc
1116                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
1117                         *fallvs(zrhol(i)) * zfice(i)
1118                 endif
1119                 zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
1120                      *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
1121!AJ<
1122                 IF (.NOT. ice_thermo) THEN
1123                   ztot    = zchau + zfroi
1124                 ELSE
1125                   zpluie = MIN(MAX(zchau,0.0),zoliq(i)*(1.-zfice(i)))
1126                   zice = MIN(MAX(zfroi,0.0),zoliq(i)*zfice(i))
1127                   ztot    = zpluie    + zice
1128                 ENDIF
1129!>AJ
1130                 ztot    = MAX(ztot   ,0.0)
1131              ENDIF
1132              ztot    = MIN(ztot,zoliq(i))
1133!AJ<
1134     !         zoliqp = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie   , 0.0)
1135     !         zoliqi = MAX(zoliq(i)*zfice(i)-1.*zice   , 0.0)
1136!JLD : les 2 variables zoliqp et zoliqi crorresponent a des pseudo precip
1137!      temporaires et ne doivent pas etre calcule (alors qu'elles le sont
1138!      si iflag_bergeron <> 2
1139!      A SUPPRIMER A TERME
1140              zoliqp(i) = MAX(zoliq(i)*(1.-zfice(i))-1.*zpluie  , 0.0)
1141              zoliqi(i) = MAX(zoliq(i)*zfice(i)-1.*zice  , 0.0)
1142              zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
1143!>AJ
1144              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
1145           ENDIF
1146        ENDDO  ! i = 1,klon
1147     ENDDO     ! n = 1,ninter
1148
1149     ! ----------------------------------------------------------------
1150     !
1151     IF (.NOT. ice_thermo) THEN
1152       DO i = 1, klon
1153         IF (rneb(i,k).GT.0.0) THEN
1154           d_ql(i,k) = zoliq(i)
1155           zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0) &
1156                * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
1157         ENDIF
1158       ENDDO
1159     ELSE
1160!
1161!CR&JYG<
1162! On prend en compte l'effet Bergeron dans les flux de precipitation :
1163! Si T < 0 C, alors les precipitations liquides sont converties en glace, ce qui
1164! provoque un accroissement de temperature DeltaT. L'effet de DeltaT sur le condensat
1165! et les precipitations est grossierement pris en compte en linearisant les equations
1166! et en approximant le processus de precipitation liquide par un processus a seuil.
1167! On fait l'hypothese que le condensat nuageux n'est pas modifié dans cette opération.
1168! Le condensat precipitant liquide est supprime (dans la limite DeltaT<273-T).
1169! Le condensat precipitant solide est augmente.
1170! La vapeur d'eau est augmentee.
1171!
1172       IF ((iflag_bergeron .EQ. 2)) THEN
1173         DO i = 1, klon
1174           IF (rneb(i,k) .GT. 0.0) THEN
1175             zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
1176             zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
1177           if (fl_cor_ebil .GT. 0) then
1178             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zmqc(i)+zcond(i)))
1179             coef1 = rneb(i,k)*RLSTT/zcp*zdqsdT_raw(i)
1180!            Calcul de DT si toute les precips liquides congelent
1181             DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
1182!            On ne veut pas que T devienne superieur a la temp. de congelation.
1183!            donc que Delta > RTT-zt(i
1184             DeltaT = max( min( RTT-zt(i), DeltaT) , 0. )
1185             zt(i)      = zt(i)      + DeltaT
1186!            Eau vaporisee du fait de l'augmentation de T
1187             Deltaq = rneb(i,k)*zdqsdT_raw(i)*DeltaT
1188!            on reajoute cette eau vaporise a la vapeur et on l'enleve des precips
1189             zq(i) = zq(i) +  Deltaq
1190!            Les 3 max si dessous prtotegent uniquement des erreurs d'arrondies
1191             zcond(i)   = max( zcond(i)- Deltaq, 0. )
1192!            precip liquide qui congele ou qui s'evapore
1193             Deltaqprecl = -zcp/RLMLT*(1.+coef1)*DeltaT
1194             zqprecl(i) = max( zqprecl(i) + Deltaqprecl, 0. )
1195!            bilan eau glacee
1196             zqpreci(i) = max (zqpreci(i) - Deltaqprecl - Deltaq, 0.)
1197           else ! if (fl_cor_ebil .GT. 0)
1198!            ancien calcul
1199             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zcond(i)))
1200             coef1 = RLMLT*zdqs(i)/RLVTT
1201             DeltaT = max( min( RTT-zt(i), RLMLT*zqprecl(i)/zcp/(1.+coef1) ) , 0.)
1202             zqpreci(i) = zqpreci(i) + zcp/RLMLT*DeltaT
1203             zqprecl(i) = max( zqprecl(i) - zcp/RLMLT*(1.+coef1)*DeltaT, 0. )
1204             zcond(i)   = max( zcond(i)   - zcp/RLVTT*zdqs(i)*DeltaT, 0. )
1205             zq(i)      = zq(i)      + zcp/RLVTT*zdqs(i)*DeltaT
1206             zt(i)      = zt(i)      + DeltaT
1207           end if ! if (fl_cor_ebil .GT. 0)
1208           ENDIF  ! rneb(i,k) .GT. 0.0
1209         ENDDO
1210         DO i = 1, klon
1211           IF (rneb(i,k).GT.0.0) THEN
1212             d_ql(i,k) = (1-zfice(i))*zoliq(i)
1213             d_qi(i,k) = zfice(i)*zoliq(i)
1214             zrfl(i) = zrfl(i)+ zqprecl(i) &
1215                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
1216             zifl(i) = zifl(i)+ zqpreci(i) &
1217                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
1218           ENDIF                     
1219         ENDDO
1220!!
1221       ELSE  ! iflag_bergeron
1222!>CR&JYG
1223!!
1224       DO i = 1, klon
1225         IF (rneb(i,k).GT.0.0) THEN
1226!CR on prend en compte la phase glace
1227!JLD inutile car on ne passe jamais ici si .not.ice_thermo
1228!           if (.not.ice_thermo) then
1229!           d_ql(i,k) = zoliq(i)
1230!           d_qi(i,k) = 0.
1231!           else
1232           d_ql(i,k) = (1-zfice(i))*zoliq(i)
1233           d_qi(i,k) = zfice(i)*zoliq(i)
1234!           endif
1235!AJ<
1236           zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
1237               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
1238           zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
1239                    *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
1240     !      zrfl(i) = zrfl(i)+  zpluie                         &
1241     !          *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
1242     !      zifl(i) = zifl(i)+  zice                    &
1243     !               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)                                   
1244
1245!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
1246           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
1247              zsolid = zrfl(i)
1248              zifl(i) = zifl(i)+zrfl(i)
1249              zrfl(i) = 0.
1250           if (fl_cor_ebil .GT. 0) then
1251              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
1252                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i)))
1253           else
1254              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
1255                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))
1256           end if
1257           ENDIF  ! (iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)
1258!RC   
1259
1260         ENDIF ! rneb(i,k).GT.0.0
1261       ENDDO
1262
1263       ENDIF  ! iflag_bergeron .EQ. 2
1264     ENDIF  ! .NOT. ice_thermo
1265
1266!CR: la fonte est faite au debut
1267!      IF (ice_thermo) THEN
1268!       DO i = 1, klon
1269!           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2
1270!           zmelt = MIN(MAX(zmelt,0.),1.)
1271!           zrfl(i)=zrfl(i)+zmelt*zifl(i)
1272!           zifl(i)=zifl(i)*(1.-zmelt)
1273!           print*,zt(i),'octavio1'
1274!           zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
1275!                      *RLMLT/RCPD/(1.0+RVTMP2*zq(i))
1276!           print*,zt(i),zrfl(i),zifl(i),zmelt,'octavio2'
1277!       ENDDO
1278!     ENDIF
1279
1280       
1281     IF (.NOT. ice_thermo) THEN
1282       DO i = 1, klon
1283         IF (zt(i).LT.RTT) THEN
1284           psfl(i,k)=zrfl(i)
1285         ELSE
1286           prfl(i,k)=zrfl(i)
1287         ENDIF
1288       ENDDO
1289     ELSE
1290     ! JAM*************************************************
1291     ! Revoir partie ci-dessous: a quoi servent psfl et prfl?
1292     ! *****************************************************
1293
1294       DO i = 1, klon
1295     !   IF (zt(i).LT.RTT) THEN
1296           psfl(i,k)=zifl(i)
1297     !   ELSE
1298           prfl(i,k)=zrfl(i)
1299     !   ENDIF
1300!>AJ
1301       ENDDO
1302     ENDIF
1303     ! ----------------------------------------------------------------
1304     ! Fin de formation des precipitations
1305     ! ----------------------------------------------------------------
1306     !
1307     ! Calculer les tendances de q et de t:
1308     !
1309     DO i = 1, klon
1310        d_q(i,k) = zq(i) - q(i,k)
1311        d_t(i,k) = zt(i) - t(i,k)
1312     ENDDO
1313     !
1314     !AA--------------- Calcul du lessivage stratiforme  -------------
1315
1316     DO i = 1,klon
1317        !
1318        if(zcond(i).gt.zoliq(i)+1.e-10) then
1319         beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
1320        else
1321         beta(i,k) = 0.
1322        endif
1323        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
1324             * (paprs(i,k)-paprs(i,k+1))/RG
1325        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
1326           !AA lessivage nucleation LMD5 dans la couche elle-meme
1327          IF (iflag_t_glace.EQ.0) THEN
1328           if (t(i,k) .GE. t_glace_min_old) THEN
1329              zalpha_tr = a_tr_sca(3)
1330           else
1331              zalpha_tr = a_tr_sca(4)
1332           endif
1333          ELSE ! of IF (iflag_t_glace.EQ.0)
1334           if (t(i,k) .GE. t_glace_min) THEN
1335              zalpha_tr = a_tr_sca(3)
1336           else
1337              zalpha_tr = a_tr_sca(4)
1338           endif
1339          ENDIF
1340           zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
1341           pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
1342           frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi
1343           !
1344           ! nucleation avec un facteur -1 au lieu de -0.5
1345           zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
1346           pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
1347        ENDIF
1348        !
1349     ENDDO      ! boucle sur i
1350     !
1351     !AA Lessivage par impaction dans les couches en-dessous
1352     DO kk = k-1, 1, -1
1353        DO i = 1, klon
1354           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
1355             IF (iflag_t_glace.EQ.0) THEN
1356              if (t(i,kk) .GE. t_glace_min_old) THEN
1357                 zalpha_tr = a_tr_sca(1)
1358              else
1359                 zalpha_tr = a_tr_sca(2)
1360              endif
1361             ELSE ! of IF (iflag_t_glace.EQ.0)
1362              if (t(i,kk) .GE. t_glace_min) THEN
1363                 zalpha_tr = a_tr_sca(1)
1364              else
1365                 zalpha_tr = a_tr_sca(2)
1366              endif
1367             ENDIF
1368              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
1369              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
1370              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
1371           ENDIF
1372        ENDDO
1373     ENDDO
1374     !
1375     !AA===============================================================
1376     !                     FIN DE LA BOUCLE VERTICALE 
1377  end DO
1378  !
1379  !AA==================================================================
1380  !
1381  ! Pluie ou neige au sol selon la temperature de la 1ere couche
1382  !
1383!CR: si la thermo de la glace est active, on calcule zifl directement
1384  IF (.NOT.ice_thermo) THEN
1385  DO i = 1, klon
1386     IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
1387!AJ<
1388!        snow(i) = zrfl(i)
1389        snow(i) = zrfl(i)+zifl(i)
1390!>AJ
1391        zlh_solid(i) = RLSTT-RLVTT
1392     ELSE
1393        rain(i) = zrfl(i)
1394        zlh_solid(i) = 0.
1395     ENDIF
1396  ENDDO
1397
1398  ELSE
1399     DO i = 1, klon
1400        snow(i) = zifl(i)
1401        rain(i) = zrfl(i)
1402     ENDDO
1403   
1404   ENDIF
1405  !
1406  ! For energy conservation : when snow is present, the solification
1407  ! latent heat is considered.
1408!CR: si thermo de la glace, neige deja prise en compte
1409  IF (.not.ice_thermo) THEN
1410  DO k = 1, klev
1411     DO i = 1, klon
1412        zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
1413        zmair(i)=(paprs(i,k)-paprs(i,k+1))/RG
1414        zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
1415        d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair(i))
1416     END DO
1417  END DO
1418  ENDIF
1419  !
1420
1421  if (ncoreczq>0) then
1422     WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
1423  endif
1424
1425END SUBROUTINE fisrtilp
Note: See TracBrowser for help on using the repository browser.