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

Diff of /trunk/Sources/phylmd/fisrtilp.f

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

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