/[lmdze]/trunk/phylmd/fisrtilp.f
ViewVC logotype

Diff of /trunk/phylmd/fisrtilp.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/fisrtilp.f90 revision 73 by guez, Fri Nov 15 17:48:30 2013 UTC trunk/Sources/phylmd/fisrtilp.f revision 213 by guez, Mon Feb 27 15:44:55 2017 UTC
# Line 8  contains Line 8  contains
8         d_ql, rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, &         d_ql, rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, &
9         frac_impa, frac_nucl, prfl, psfl, rhcl)         frac_impa, frac_nucl, prfl, psfl, rhcl)
10    
11      ! From phylmd/fisrtilp.F, version 1.2 2004/11/09 16:55:40      ! From phylmd/fisrtilp.F, version 1.2, 2004/11/09 16:55:40
12      ! Author: Z. X. Li (LMD/CNRS), 20 mars 1995      ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995
13    
14      ! Objet : condensation et précipitation stratiforme, schéma de      ! Objet : condensation et pr\'ecipitation stratiforme, sch\'ema de
15      ! nuage, schéma de condensation à grande échelle (pluie).      ! nuage, sch\'ema de condensation \`a grande \'echelle (pluie).
16    
     USE dimphy, ONLY: klev, klon  
     USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt  
     USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2  
     USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep  
17      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &
18           cld_tau_lsc, coef_eva, ffallv_con, ffallv_lsc, iflag_pdf, reevap_ice           cld_tau_lsc, coef_eva, ffallv_con, ffallv_lsc, iflag_pdf, reevap_ice
19        USE dimphy, ONLY: klev, klon
20        USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats
21      USE numer_rec_95, ONLY: nr_erf      USE numer_rec_95, ONLY: nr_erf
22        USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt
23        USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
24    
25      ! Arguments:      REAL, INTENT (IN):: dtime ! intervalle du temps (s)
26        REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche
     REAL, INTENT (IN):: dtime ! intervalle du temps (s)                  
     REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche    
27      REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche      REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche
28      REAL, INTENT (IN):: t(klon, klev) ! temperature (K)      REAL, INTENT (IN):: t(klon, klev) ! temperature (K)
29      REAL, INTENT (IN):: q(klon, klev) ! humidite specifique (kg/kg)      REAL, INTENT (IN):: q(klon, klev) ! humidite specifique (kg/kg)
30      LOGICAL ptconv(klon, klev) ! determine la largeur de distribution de vapeur      LOGICAL, INTENT (IN):: ptconv(klon, klev)
31      REAL ratqs(klon, klev) ! determine la largeur de distribution de vapeur  
32      REAL d_t(klon, klev) ! incrementation de la temperature (K)              REAL, INTENT (IN):: ratqs(klon, klev)
33      REAL d_q(klon, klev) ! incrementation de la vapeur d'eau                ! determine la largeur de distribution de vapeur
34      REAL d_ql(klon, klev) ! incrementation de l'eau liquide              
35      REAL rneb(klon, klev) ! fraction nuageuse                                REAL, INTENT (out):: d_t(klon, klev) ! incrementation de la temperature (K)
36      REAL radliq(klon, klev) ! eau liquide utilisee dans rayonnements        REAL, INTENT (out):: d_q(klon, klev) ! incrementation de la vapeur d'eau
37      REAL rain(klon) ! pluies (mm/s)                                        REAL, INTENT (out):: d_ql(klon, klev) ! incrementation de l'eau liquide
38      REAL snow(klon) ! neige (mm/s)                                          REAL, INTENT (out):: rneb(klon, klev) ! fraction nuageuse
39    
40      ! Coeffients de fraction lessivee : pour OFF-LINE      REAL, INTENT (out):: radliq(klon, klev)
41      REAL pfrac_impa(klon, klev)      ! eau liquide utilisee dans rayonnement
42      REAL pfrac_nucl(klon, klev)  
43      REAL pfrac_1nucl(klon, klev)      REAL, INTENT (out):: rain(klon) ! pluies (mm/s)
44        REAL, INTENT (out):: snow(klon) ! neige (mm/s)
45      ! Fraction d'aerosols lessivee par impaction et par nucleation  
46      ! POur ON-LINE      ! Coeffients de fraction lessivee :
47      REAL frac_nucl(klon, klev)      REAL, INTENT (inout):: pfrac_impa(klon, klev)
48        REAL, INTENT (inout):: pfrac_nucl(klon, klev)
49      REAL prfl(klon, klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)      REAL, INTENT (inout):: pfrac_1nucl(klon, klev)
50      REAL psfl(klon, klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)  
51      REAL rhcl(klon, klev) ! humidite relative en ciel clair                  ! Fraction d'aerosols lessivee par impaction
52        REAL, INTENT (out):: frac_impa(klon, klev)
53    
54        ! Fraction d'aerosols lessivee par nucleation
55        REAL, INTENT (out):: frac_nucl(klon, klev)
56    
57        REAL, INTENT (out):: prfl(klon, klev+1)
58        ! flux d'eau precipitante aux interfaces (kg/m2/s)
59    
60        REAL, INTENT (out):: psfl(klon, klev+1)
61        ! flux d'eau precipitante aux interfaces (kg/m2/s)
62    
63        REAL, INTENT (out):: rhcl(klon, klev) ! humidite relative en ciel clair
64    
65      ! Local:      ! Local:
66    
     ! Fraction d'aerosols lessivee par impaction et par nucleation  
     ! POur ON-LINE  
     REAL frac_impa(klon, klev)  
67      REAL zct(klon), zcl(klon)      REAL zct(klon), zcl(klon)
     !AA  
68    
69      ! Options du programme:      ! Options du programme:
70    
# Line 67  contains Line 73  contains
73    
74      INTEGER ninter ! sous-intervals pour la precipitation      INTEGER ninter ! sous-intervals pour la precipitation
75      PARAMETER (ninter=5)      PARAMETER (ninter=5)
76      LOGICAL evap_prec ! evaporation de la pluie                            LOGICAL evap_prec ! evaporation de la pluie
77      PARAMETER (evap_prec=.TRUE.)      PARAMETER (evap_prec=.TRUE.)
78      REAL zpdf_sig(klon), zpdf_k(klon), zpdf_delta(klon)      REAL zpdf_sig(klon), zpdf_k(klon), zpdf_delta(klon)
79      REAL zpdf_a(klon), zpdf_b(klon), zpdf_e1(klon), zpdf_e2(klon)      REAL zpdf_a(klon), zpdf_b(klon), zpdf_e1(klon), zpdf_e2(klon)
80    
81      LOGICAL cpartiel ! condensation partielle                              LOGICAL cpartiel ! condensation partielle
82      PARAMETER (cpartiel=.TRUE.)      PARAMETER (cpartiel=.TRUE.)
83      REAL t_coup      REAL t_coup
84      PARAMETER (t_coup=234.0)      PARAMETER (t_coup=234.0)
85    
     ! Variables locales:  
   
86      INTEGER i, k, n, kk      INTEGER i, k, n, kk
87      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5      REAL zqs(klon), zdqs(klon), zcor, zcvm5
88        logical zdelta
89      REAL zrfl(klon), zrfln(klon), zqev, zqevt      REAL zrfl(klon), zrfln(klon), zqev, zqevt
90      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
91      REAL ztglace, zt(klon)      REAL ztglace, zt(klon)
92      INTEGER nexpo ! exponentiel pour glace/eau                              INTEGER nexpo ! exponentiel pour glace/eau
93      REAL zdz(klon), zrho(klon), ztot(klon), zrhol(klon)      REAL zdz(klon), zrho(klon), ztot(klon), zrhol(klon)
94      REAL zchau(klon), zfroi(klon), zfice(klon), zneb(klon)      REAL zchau(klon), zfroi(klon), zfice(klon), zneb(klon)
95    
96      LOGICAL appel1er      LOGICAL:: appel1er = .TRUE.
     SAVE appel1er  
   
     !---------------------------------------------------------------  
97    
98      !AA Variables traceurs:      ! Variables traceurs:
99      !AA  Provisoire !!! Parametres alpha du lessivage      ! Provisoire !!! Parametres alpha du lessivage
100      !AA  A priori on a 4 scavenging numbers possibles      ! A priori on a 4 scavenging numbers possibles
101    
102      REAL a_tr_sca(4)      REAL, save:: a_tr_sca(4)
     SAVE a_tr_sca  
103    
104      ! Variables intermediaires      ! Variables intermediaires
105    
106      REAL zalpha_tr      REAL zalpha_tr
107      REAL zfrac_lessi      REAL zfrac_lessi
108      REAL zprec_cond(klon)      REAL zprec_cond(klon)
     !AA  
109      REAL zmair, zcpair, zcpeau      REAL zmair, zcpair, zcpeau
110      !     Pour la conversion eau-neige      ! Pour la conversion eau-neige
111      REAL zlh_solid(klon), zm_solid      REAL zlh_solid(klon), zm_solid
     !IM  
     INTEGER klevm1  
     !---------------------------------------------------------------  
   
     ! Fonctions en ligne:  
112    
113      REAL fallvs, fallvc ! vitesse de chute pour crystaux de glace            !---------------------------------------------------------------
     REAL zzz  
   
     fallvc(zzz) = 3.29/2.0*((zzz)**0.16)*ffallv_con  
     fallvs(zzz) = 3.29/2.0*((zzz)**0.16)*ffallv_lsc  
114    
     DATA appel1er/ .TRUE./  
     !ym  
115      zdelq = 0.0      zdelq = 0.0
116    
117      IF (appel1er) THEN      IF (appel1er) THEN
   
118         PRINT *, 'fisrtilp, ninter:', ninter         PRINT *, 'fisrtilp, ninter:', ninter
119         PRINT *, 'fisrtilp, evap_prec:', evap_prec         PRINT *, 'fisrtilp, evap_prec:', evap_prec
120         PRINT *, 'fisrtilp, cpartiel:', cpartiel         PRINT *, 'fisrtilp, cpartiel:', cpartiel
121         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN
122            PRINT *, "fisrtilp : ce n'est pas prévu, voir Z. X. Li", dtime            PRINT *, "fisrtilp : ce n'est pas pr\'evu, voir Z. X. Li", dtime
123            PRINT *, 'Je préfère un sous-intervalle de 6 minutes.'            PRINT *, "Je pr\'ef\`ere un sous-intervalle de 6 minutes."
124         END IF         END IF
125         appel1er = .FALSE.         appel1er = .FALSE.
126    
127         !AA initialiation provisoire         ! initialiation provisoire
128         a_tr_sca(1) = -0.5         a_tr_sca(1) = -0.5
129         a_tr_sca(2) = -0.5         a_tr_sca(2) = -0.5
130         a_tr_sca(3) = -0.5         a_tr_sca(3) = -0.5
131         a_tr_sca(4) = -0.5         a_tr_sca(4) = -0.5
132    
133         !AA Initialisation a 1 des coefs des fractions lessivees         ! Initialisation a 1 des coefs des fractions lessivees
   
134         DO k = 1, klev         DO k = 1, klev
135            DO i = 1, klon            DO i = 1, klon
136               pfrac_nucl(i, k) = 1.               pfrac_nucl(i, k) = 1.
# Line 151  contains Line 138  contains
138               pfrac_impa(i, k) = 1.               pfrac_impa(i, k) = 1.
139            END DO            END DO
140         END DO         END DO
141        END IF
142    
143        ! Initialisation a 0 de zoliq
     END IF !  test sur appel1er  
     !MAf Initialisation a 0 de zoliq  
144      DO i = 1, klon      DO i = 1, klon
145         zoliq(i) = 0.         zoliq(i) = 0.
146      END DO      END DO
147      ! Determiner les nuages froids par leur temperature      ! Determiner les nuages froids par leur temperature
148      !  nexpo regle la raideur de la transition eau liquide / eau glace.      ! nexpo regle la raideur de la transition eau liquide / eau glace.
149    
150      ztglace = rtt - 15.0      ztglace = rtt - 15.0
151      nexpo = 6      nexpo = 6
     !cc      nexpo = 1  
152    
153      ! Initialiser les sorties:      ! Initialiser les sorties:
154    
# Line 197  contains Line 182  contains
182         zneb(i) = seuil_neb         zneb(i) = seuil_neb
183      END DO      END DO
184    
185        ! Pour plus de securite
     !AA Pour plus de securite  
186    
187      zalpha_tr = 0.      zalpha_tr = 0.
188      zfrac_lessi = 0.      zfrac_lessi = 0.
189    
190      !AA----------------------------------------------------------      loop_vertical: DO k = klev, 1, -1
   
     ! Boucle verticale (du haut vers le bas)  
   
     !IM : klevm1  
     klevm1 = klev - 1  
     DO  k = klev, 1, -1  
   
        !AA----------------------------------------------------------  
   
191         DO i = 1, klon         DO i = 1, klon
192            zt(i) = t(i, k)            zt(i) = t(i, k)
193            zq(i) = q(i, k)            zq(i) = q(i, k)
# Line 225  contains Line 200  contains
200         ! surface.         ! surface.
201    
202         DO i = 1, klon         DO i = 1, klon
203            IF (k<=klevm1) THEN            IF (k <= klev - 1) THEN
204               zmair = (paprs(i, k)-paprs(i, k+1))/rg               zmair = (paprs(i, k)-paprs(i, k+1))/rg
205               zcpair = rcpd*(1.0+rvtmp2*zq(i))               zcpair = rcpd*(1.0+rvtmp2*zq(i))
206               zcpeau = rcpd*rvtmp2               zcpeau = rcpd*rvtmp2
# Line 235  contains Line 210  contains
210            END IF            END IF
211         END DO         END DO
212    
        ! Calculer l'evaporation de la precipitation  
   
   
   
213         IF (evap_prec) THEN         IF (evap_prec) THEN
214              ! Calculer l'evaporation de la precipitation
215            DO i = 1, klon            DO i = 1, klon
216               IF (zrfl(i)>0.) THEN               IF (zrfl(i)>0.) THEN
217                  IF (thermcep) THEN                  zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)
218                     zdelta = max(0., sign(1., rtt-zt(i)))                  zqs(i) = min(0.5, zqs(i))
219                     zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)                  zcor = 1./(1.-retv*zqs(i))
220                     zqs(i) = min(0.5, zqs(i))                  zqs(i) = zqs(i)*zcor
                    zcor = 1./(1.-retv*zqs(i))  
                    zqs(i) = zqs(i)*zcor  
                 ELSE  
                    IF (zt(i)<t_coup) THEN  
                       zqs(i) = qsats(zt(i))/pplay(i, k)  
                    ELSE  
                       zqs(i) = qsatl(zt(i))/pplay(i, k)  
                    END IF  
                 END IF  
221                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))
222                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &
223                       (paprs(i, k)-paprs(i, k+1))/pplay(i, k)*zt(i)*rd/rg                       (paprs(i, k)-paprs(i, k+1))/pplay(i, k)*zt(i)*rd/rg
# Line 263  contains Line 226  contains
226                  zqev = min(zqev, zqevt)                  zqev = min(zqev, zqevt)
227                  zrfln(i) = zrfl(i) - zqev*(paprs(i, k)-paprs(i, k+1))/rg/dtime                  zrfln(i) = zrfl(i) - zqev*(paprs(i, k)-paprs(i, k+1))/rg/dtime
228    
229                  ! pour la glace, on réévapore toute la précip dans la                  ! pour la glace, on r\'e\'evapore toute la pr\'ecip dans la
230                  ! couche du dessous la glace venant de la couche du                  ! couche du dessous la glace venant de la couche du
231                  ! dessus est simplement dans la couche du dessous.                  ! dessus est simplement dans la couche du dessous.
232    
# Line 280  contains Line 243  contains
243    
244         ! Calculer Qs et L/Cp*dQs/dT:         ! Calculer Qs et L/Cp*dQs/dT:
245    
246         IF (thermcep) THEN         DO i = 1, klon
247            DO i = 1, klon            zdelta = rtt >= zt(i)
248               zdelta = max(0., sign(1., rtt-zt(i)))            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
249               zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta            zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))
250               zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))            zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
251               zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)            zqs(i) = min(0.5, zqs(i))
252               zqs(i) = min(0.5, zqs(i))            zcor = 1./(1.-retv*zqs(i))
253               zcor = 1./(1.-retv*zqs(i))            zqs(i) = zqs(i)*zcor
254               zqs(i) = zqs(i)*zcor            zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)
255               zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)         END DO
           END DO  
        ELSE  
           DO i = 1, klon  
              IF (zt(i)<t_coup) THEN  
                 zqs(i) = qsats(zt(i))/pplay(i, k)  
                 zdqs(i) = dqsats(zt(i), zqs(i))  
              ELSE  
                 zqs(i) = qsatl(zt(i))/pplay(i, k)  
                 zdqs(i) = dqsatl(zt(i), zqs(i))  
              END IF  
           END DO  
        END IF  
256    
257         ! Determiner la condensation partielle et calculer la quantite         ! Determiner la condensation partielle et calculer la quantite
258         ! de l'eau condensee:         ! de l'eau condensee:
259    
260         IF (cpartiel) THEN         IF (cpartiel) THEN
261              ! Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
262              ! nuageuse a partir des PDF de Sandrine Bony.
263              ! rneb : fraction nuageuse
264              ! zqn : eau totale dans le nuage
265              ! zcond : eau condensee moyenne dans la maille.
266    
267            !        print*, 'Dans partiel k=', k            ! on prend en compte le r\'echauffement qui diminue
268              ! la partie condens\'ee
269    
270            !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau            ! Version avec les ratqs
           !   nuageuse a partir des PDF de Sandrine Bony.  
           !   rneb  : fraction nuageuse  
           !   zqn   : eau totale dans le nuage  
           !   zcond : eau condensee moyenne dans la maille.  
   
           !           on prend en compte le réchauffement qui diminue  
           !           la partie condensee  
   
           !   Version avec les raqts  
271    
272            IF (iflag_pdf==0) THEN            IF (iflag_pdf==0) THEN
   
273               DO i = 1, klon               DO i = 1, klon
274                  zdelq = min(ratqs(i, k), 0.99)*zq(i)                  zdelq = min(ratqs(i, k), 0.99)*zq(i)
275                  rneb(i, k) = (zq(i)+zdelq-zqs(i))/(2.0*zdelq)                  rneb(i, k) = (zq(i)+zdelq-zqs(i))/(2.0*zdelq)
276                  zqn(i) = (zq(i)+zdelq+zqs(i))/2.0                  zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
277               END DO               END DO
   
278            ELSE            ELSE
279                 ! Version avec les nouvelles PDFs.
              !   Version avec les nouvelles PDFs.  
280               DO i = 1, klon               DO i = 1, klon
281                  IF (zq(i)<1.E-15) THEN                  IF (zq(i) < 1E-15) THEN
282                     zq(i) = 1.E-15                     zq(i) = 1E-15
283                  END IF                  END IF
284               END DO               END DO
285               DO i = 1, klon               DO i = 1, klon
# Line 356  contains Line 301  contains
301                     rneb(i, k) = 0.5*zpdf_e1(i)                     rneb(i, k) = 0.5*zpdf_e1(i)
302                     zqn(i) = zq(i)*zpdf_e2(i)/zpdf_e1(i)                     zqn(i) = zq(i)*zpdf_e2(i)/zpdf_e1(i)
303                  END IF                  END IF
   
304               END DO               END DO
   
   
305            END IF            END IF
306            ! iflag_pdf                                                
307            DO i = 1, klon            DO i = 1, klon
308               IF (rneb(i, k)<=0.0) zqn(i) = 0.0               IF (rneb(i, k)<=0.0) zqn(i) = 0.0
309               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)
310               rneb(i, k) = max(0.0, min(1.0, rneb(i, k)))               rneb(i, k) = max(0., min(1., rneb(i, k)))
311               !  On ne divise pas par 1+zdqs pour forcer a avoir l'eau               ! On ne divise pas par 1 + zdqs pour forcer \`a avoir l'eau
312               !  predite par la convection.  ATTENTION !!! Il va               ! pr\'edite par la convection. Attention : il va falloir
313               !  falloir verifier tout ca.               ! verifier tout ca.
314               zcond(i) = max(0.0, zqn(i)-zqs(i))*rneb(i, k)               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)
              !           print*, 'ZDQS ', zdqs(i)  
              !--Olivier  
315               rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)               rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)
316               IF (rneb(i, k)<=0.0) rhcl(i, k) = zq(i)/zqs(i)               IF (rneb(i, k) <= 0.) rhcl(i, k) = zq(i) / zqs(i)
317               IF (rneb(i, k)>=1.0) rhcl(i, k) = 1.0               IF (rneb(i, k) >= 1.) rhcl(i, k) = 1.
              !--fin  
318            END DO            END DO
319         ELSE         ELSE
320            DO i = 1, klon            DO i = 1, klon
# Line 390  contains Line 329  contains
329    
330         DO i = 1, klon         DO i = 1, klon
331            zq(i) = zq(i) - zcond(i)            zq(i) = zq(i) - zcond(i)
           !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD  
332            zt(i) = zt(i) + zcond(i)*rlvtt/rcpd/(1.0+rvtmp2*zq(i))            zt(i) = zt(i) + zcond(i)*rlvtt/rcpd/(1.0+rvtmp2*zq(i))
333         END DO         END DO
334    
# Line 421  contains Line 359  contains
359                     zcl(i) = cld_lc_lsc                     zcl(i) = cld_lc_lsc
360                     zct(i) = 1./cld_tau_lsc                     zct(i) = 1./cld_tau_lsc
361                  END IF                  END IF
362                  !  quantité d'eau à élminier.                  ! quantit\'e d'eau \`a \'eliminer
363                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &
364                       (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i))                       (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i))
365                  !  meme chose pour la glace.                  ! m\^eme chose pour la glace
366                  IF (ptconv(i, k)) THEN                  IF (ptconv(i, k)) THEN
367                     zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* &                     zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* &
368                          fallvc(zrhol(i))*zfice(i)                          fallvc(zrhol(i))*zfice(i)
# Line 454  contains Line 392  contains
392            END IF            END IF
393         END DO         END DO
394    
395         ! Calculer les tendances de q et de t:         ! Calculer les tendances de q et de t :
   
396         DO i = 1, klon         DO i = 1, klon
397            d_q(i, k) = zq(i) - q(i, k)            d_q(i, k) = zq(i) - q(i, k)
398            d_t(i, k) = zt(i) - t(i, k)            d_t(i, k) = zt(i) - t(i, k)
399         END DO         END DO
400    
401         !AA--------------- Calcul du lessivage stratiforme  -------------         ! Calcul du lessivage stratiforme
   
402         DO i = 1, klon         DO i = 1, klon
403            zprec_cond(i) = max(zcond(i)-zoliq(i), 0.0)* &            zprec_cond(i) = max(zcond(i) - zoliq(i), 0.0) &
404                 (paprs(i, k)-paprs(i, k+1))/rg                 * (paprs(i, k)-paprs(i, k+1))/rg
405            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN
406               !AA lessivage nucleation LMD5 dans la couche elle-meme               ! lessivage nucleation LMD5 dans la couche elle-meme
407               IF (t(i, k)>=ztglace) THEN               IF (t(i, k)>=ztglace) THEN
408                  zalpha_tr = a_tr_sca(3)                  zalpha_tr = a_tr_sca(3)
409               ELSE               ELSE
# Line 481  contains Line 417  contains
417               zfrac_lessi = 1. - exp(-zprec_cond(i)/zneb(i))               zfrac_lessi = 1. - exp(-zprec_cond(i)/zneb(i))
418               pfrac_1nucl(i, k) = pfrac_1nucl(i, k)*(1.-zneb(i)*zfrac_lessi)               pfrac_1nucl(i, k) = pfrac_1nucl(i, k)*(1.-zneb(i)*zfrac_lessi)
419            END IF            END IF
   
   
420         END DO         END DO
421         !AA Lessivage par impaction dans les couches en-dessous  
422         ! boucle sur i                                                 ! Lessivage par impaction dans les couches en-dessous
423           ! boucle sur i
424         DO kk = k - 1, 1, -1         DO kk = k - 1, 1, -1
425            DO i = 1, klon            DO i = 1, klon
426               IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN               IF (rneb(i, k)>0. .AND. zprec_cond(i)>0.) THEN
427                  IF (t(i, kk)>=ztglace) THEN                  IF (t(i, kk)>=ztglace) THEN
428                     zalpha_tr = a_tr_sca(1)                     zalpha_tr = a_tr_sca(1)
429                  ELSE                  ELSE
# Line 500  contains Line 435  contains
435               END IF               END IF
436            END DO            END DO
437         END DO         END DO
438        end DO loop_vertical
        !AA----------------------------------------------------------  
        !                     FIN DE BOUCLE SUR K  
     end DO  
   
     !AA-----------------------------------------------------------  
439    
440      ! Pluie ou neige au sol selon la temperature de la 1ere couche      ! Pluie ou neige au sol selon la temperature de la 1ere couche
441    
# Line 530  contains Line 460  contains
460         END DO         END DO
461      END DO      END DO
462    
463      contains
464    
465        ! vitesse de chute pour cristaux de glace
466    
467        REAL function fallvs(zzz)
468          REAL, intent(in):: zzz
469          fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
470        end function fallvs
471    
472        !********************************************************
473    
474        real function fallvc(zzz)
475          REAL, intent(in):: zzz
476          fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
477        end function fallvc
478    
479    END SUBROUTINE fisrtilp    END SUBROUTINE fisrtilp
480    
481  end module fisrtilp_m  end module fisrtilp_m
Legend:
Removed from v.73  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21