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

Diff of /trunk/phylmd/fisrtilp.f90

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

trunk/libf/phylmd/fisrtilp.f90 revision 22 by guez, Fri Jul 31 15:18:47 2009 UTC trunk/phylmd/fisrtilp.f90 revision 339 by guez, Thu Sep 26 17:08:42 2019 UTC
# Line 1  Line 1 
1  SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs,d_t,d_q,d_ql,rneb, &  module fisrtilp_m
      radliq,rain,snow,pfrac_impa,pfrac_nucl,pfrac_1nucl,frac_impa, &  
      frac_nucl,prfl,psfl,rhcl)  
   
   ! From phylmd/fisrtilp.F,v 1.2 2004/11/09 16:55:40  
   ! Auteur(s): Z.X. Li (LMD/CNRS)  
   ! Date: le 20 mars 1995  
   ! Objet: condensation et precipitation stratiforme.  
   !        schema de nuage  
   
   USE dimens_m  
   USE dimphy  
   USE tracstoke  
   USE yomcst  
   USE yoethf  
   USE fcttre  
   USE comfisrtilp  
   use numer_rec, only: erf  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! Arguments:  contains
6    
7    REAL, INTENT (IN) :: & ! intervalle du temps (s)                    SUBROUTINE fisrtilp(paprs, pplay, t, q, ptconv, ratqs, d_t, d_q, d_ql, rneb, &
8         dtime         cldliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, &
9    REAL, INTENT (IN) :: paprs(klon,klev+1) ! pression a inter-couche           frac_nucl, prfl, psfl, rhcl)
10    REAL, INTENT (IN) :: pplay(klon,klev) ! pression au milieu de couche  
11    REAL t(klon,klev) ! temperature (K)                                    ! From phylmd/fisrtilp.F, version 1.2, 2004/11/09 16:55:40
12    REAL q(klon,klev) ! humidite specifique (kg/kg)                        ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995
13    REAL d_t(klon,klev) ! incrementation de la temperature (K)          
14    REAL d_q(klon,klev) ! incrementation de la vapeur d'eau                ! Objet : condensation et pr\'ecipitation stratiforme, sch\'ema de
15    REAL d_ql(klon,klev) ! incrementation de l'eau liquide                  ! nuage, sch\'ema de condensation \`a grande \'echelle (pluie).
16    REAL rneb(klon,klev) ! fraction nuageuse                            
17    REAL radliq(klon,klev) ! eau liquide utilisee dans rayonnements        USE numer_rec_95, ONLY: nr_erf
18    REAL rhcl(klon,klev) ! humidite relative en ciel clair              
19    REAL rain(klon) ! pluies (mm/s)                                        use comconst, only: dtphys
20    REAL snow(klon) ! neige (mm/s)                                          USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &
21    REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)           cld_tau_lsc, coef_eva, ffallv_con, ffallv_lsc, iflag_pdf, reevap_ice
22    REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)      USE dimphy, ONLY: klev, klon
23    ! Coeffients de fraction lessivee : pour OFF-LINE      USE fcttre, ONLY: foede, foeew
24        USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt
25    REAL pfrac_nucl(klon,klev)      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
26    REAL pfrac_1nucl(klon,klev)  
27    REAL pfrac_impa(klon,klev)      REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche
28        REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche
29    ! Fraction d'aerosols lessivee par impaction et par nucleation      REAL, INTENT (IN):: t(klon, klev) ! temperature (K)
30    ! POur ON-LINE      REAL, INTENT (IN):: q(klon, klev) ! humidite specifique (kg/kg)
31        LOGICAL, INTENT (IN):: ptconv(klon, klev)
32    REAL frac_impa(klon,klev)  
33    REAL frac_nucl(klon,klev)      REAL, INTENT (IN):: ratqs(klon, klev)
34    REAL zct(klon), zcl(klon)      ! determine la largeur de distribution de vapeur
35    !AA  
36        REAL, INTENT (out):: d_t(klon, klev) ! incrementation de la temperature (K)
37    ! Options du programme:      REAL, INTENT (out):: d_q(klon, klev) ! incrementation de la vapeur d'eau
38        REAL, INTENT (out):: d_ql(klon, klev) ! incrementation de l'eau liquide
39    REAL seuil_neb ! un nuage existe vraiment au-dela      REAL, INTENT (out):: rneb(klon, klev) ! fraction nuageuse
40    PARAMETER (seuil_neb=0.001)  
41        REAL, INTENT (out):: cldliq(klon, klev)
42    INTEGER ninter ! sous-intervals pour la precipitation      ! eau liquide utilisee dans rayonnement
43    PARAMETER (ninter=5)  
44    LOGICAL evap_prec ! evaporation de la pluie                            REAL, INTENT (out):: rain(klon) ! pluies (mm/s)
45    PARAMETER (evap_prec=.TRUE.)      REAL, INTENT (out):: snow(klon) ! neige (mm/s)
46    REAL ratqs(klon,klev) ! determine la largeur de distribution de vapeur  
47    LOGICAL ptconv(klon,klev) ! determine la largeur de distribution de vapeur      ! Coeffients de fraction lessivee :
48    REAL zpdf_sig(klon), zpdf_k(klon), zpdf_delta(klon)      REAL, INTENT (inout):: pfrac_impa(klon, klev)
49    REAL zpdf_a(klon), zpdf_b(klon), zpdf_e1(klon), zpdf_e2(klon)      REAL, INTENT (inout):: pfrac_nucl(klon, klev)
50        REAL, INTENT (inout):: pfrac_1nucl(klon, klev)
51    LOGICAL cpartiel ! condensation partielle                          
52    PARAMETER (cpartiel=.TRUE.)      ! Fraction d'aerosols lessivee par impaction
53    REAL t_coup      REAL, INTENT (out):: frac_impa(klon, klev)
54    PARAMETER (t_coup=234.0)  
55        ! Fraction d'aerosols lessivee par nucleation
56    ! Variables locales:      REAL, INTENT (out):: frac_nucl(klon, klev)
57    
58    INTEGER i, k, n, kk      REAL, INTENT (out):: prfl(klon, klev+1)
59    REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5      ! flux d'eau precipitante aux interfaces (kg/m2/s)
60    REAL zrfl(klon), zrfln(klon), zqev, zqevt  
61    REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq      REAL, INTENT (out):: psfl(klon, klev+1)
62    REAL ztglace, zt(klon)      ! flux d'eau precipitante aux interfaces (kg/m2/s)
63    INTEGER nexpo ! exponentiel pour glace/eau                          
64    REAL zdz(klon), zrho(klon), ztot(klon), zrhol(klon)      REAL, INTENT (out):: rhcl(klon, klev) ! humidite relative en ciel clair
65    REAL zchau(klon), zfroi(klon), zfice(klon), zneb(klon)  
66        ! Local:
67    LOGICAL appel1er  
68    SAVE appel1er      REAL zct(klon), zcl(klon)
69    
70    !---------------------------------------------------------------      ! Options du programme:
71    
72    !AA Variables traceurs:      REAL seuil_neb ! un nuage existe vraiment au-dela
73    !AA  Provisoire !!! Parametres alpha du lessivage      PARAMETER (seuil_neb=0.001)
74    !AA  A priori on a 4 scavenging numbers possibles  
75        INTEGER ninter ! sous-intervals pour la precipitation
76    REAL a_tr_sca(4)      PARAMETER (ninter=5)
77    SAVE a_tr_sca      LOGICAL evap_prec ! evaporation de la pluie
78        PARAMETER (evap_prec=.TRUE.)
79    ! Variables intermediaires      REAL zpdf_sig(klon), zpdf_k(klon), zpdf_delta(klon)
80        REAL zpdf_a(klon), zpdf_b(klon), zpdf_e1(klon), zpdf_e2(klon)
81    REAL zalpha_tr  
82    REAL zfrac_lessi      LOGICAL cpartiel ! condensation partielle
83    REAL zprec_cond(klon)      PARAMETER (cpartiel=.TRUE.)
84    !AA      REAL t_coup
85    REAL zmair, zcpair, zcpeau      PARAMETER (t_coup=234.0)
86    !     Pour la conversion eau-neige  
87    REAL zlh_solid(klon), zm_solid      INTEGER i, k, n, kk
88    !IM      REAL zqs(klon), zdqs(klon), zcor, zcvm5
89    INTEGER klevm1      logical zdelta
90    !---------------------------------------------------------------      REAL zrfl(klon), zrfln(klon), zqev, zqevt
91        REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
92    ! Fonctions en ligne:      REAL ztglace, zt(klon)
93        INTEGER nexpo ! exponentiel pour glace/eau
94    REAL fallvs, fallvc ! vitesse de chute pour crystaux de glace            REAL zdz(klon), zrho(klon), ztot(klon), zrhol(klon)
95    REAL zzz      REAL zchau(klon), zfroi(klon), zfice(klon), zneb(klon)
96    
97    fallvc(zzz) = 3.29/2.0*((zzz)**0.16)*ffallv_con      LOGICAL:: appel1er = .TRUE.
98    fallvs(zzz) = 3.29/2.0*((zzz)**0.16)*ffallv_lsc  
99        ! Variables traceurs:
100    DATA appel1er/ .TRUE./      ! Provisoire !!! Parametres alpha du lessivage
101    !ym      ! A priori on a 4 scavenging numbers possibles
102    zdelq = 0.0  
103        REAL, save:: a_tr_sca(4)
104    IF (appel1er) THEN  
105        ! Variables intermediaires
106       PRINT *, 'fisrtilp, ninter:', ninter  
107       PRINT *, 'fisrtilp, evap_prec:', evap_prec      REAL zalpha_tr
108       PRINT *, 'fisrtilp, cpartiel:', cpartiel      REAL zfrac_lessi
109       IF (abs(dtime/float(ninter)-360.0)>0.001) THEN      REAL zprec_cond(klon)
110          PRINT *, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime      REAL zmair, zcpair, zcpeau
111          PRINT *, 'Je prefere un sous-intervalle de 6 minutes'      ! Pour la conversion eau-neige
112          !         stop 1      REAL zlh_solid(klon), zm_solid
113       END IF  
114       appel1er = .FALSE.      !---------------------------------------------------------------
115    
116       !AA initialiation provisoire      zdelq = 0.0
117       a_tr_sca(1) = -0.5  
118       a_tr_sca(2) = -0.5      IF (appel1er) THEN
119       a_tr_sca(3) = -0.5         PRINT *, 'fisrtilp, ninter:', ninter
120       a_tr_sca(4) = -0.5         PRINT *, 'fisrtilp, evap_prec:', evap_prec
121           PRINT *, 'fisrtilp, cpartiel:', cpartiel
122       !AA Initialisation a 1 des coefs des fractions lessivees         IF (abs(dtphys / real(ninter) - 360.) > 0.001) THEN
123              PRINT *, "fisrtilp : ce n'est pas pr\'evu, voir Z. X. Li", dtphys
124       DO k = 1, klev            PRINT *, "Je pr\'ef\`ere un sous-intervalle de 6 minutes."
125          DO i = 1, klon         END IF
126             pfrac_nucl(i,k) = 1.         appel1er = .FALSE.
127             pfrac_1nucl(i,k) = 1.  
128             pfrac_impa(i,k) = 1.         ! initialiation provisoire
129          END DO         a_tr_sca(1) = -0.5
130       END DO         a_tr_sca(2) = -0.5
131           a_tr_sca(3) = -0.5
132           a_tr_sca(4) = -0.5
133    END IF !  test sur appel1er  
134    !MAf Initialisation a 0 de zoliq         ! Initialisation a 1 des coefs des fractions lessivees
135    DO i = 1, klon         DO k = 1, klev
136       zoliq(i) = 0.            DO i = 1, klon
137    END DO               pfrac_nucl(i, k) = 1.
138    ! Determiner les nuages froids par leur temperature               pfrac_1nucl(i, k) = 1.
139    !  nexpo regle la raideur de la transition eau liquide / eau glace.               pfrac_impa(i, k) = 1.
140              END DO
141    ztglace = rtt - 15.0         END DO
142    nexpo = 6      END IF
143    !cc      nexpo = 1  
144        ! Initialisation a 0 de zoliq
145    ! Initialiser les sorties:      DO i = 1, klon
146           zoliq(i) = 0.
147    DO k = 1, klev + 1      END DO
148       DO i = 1, klon      ! Determiner les nuages froids par leur temperature
149          prfl(i,k) = 0.0      ! nexpo regle la raideur de la transition eau liquide / eau glace.
150          psfl(i,k) = 0.0  
151       END DO      ztglace = rtt - 15.0
152    END DO      nexpo = 6
153    
154    DO k = 1, klev      ! Initialiser les sorties:
155       DO i = 1, klon  
156          d_t(i,k) = 0.0      DO k = 1, klev + 1
157          d_q(i,k) = 0.0         DO i = 1, klon
158          d_ql(i,k) = 0.0            prfl(i, k) = 0.0
159          rneb(i,k) = 0.0            psfl(i, k) = 0.0
160          radliq(i,k) = 0.0         END DO
161          frac_nucl(i,k) = 1.      END DO
162          frac_impa(i,k) = 1.  
163       END DO      DO k = 1, klev
164    END DO         DO i = 1, klon
165    DO i = 1, klon            d_t(i, k) = 0.0
166       rain(i) = 0.0            d_q(i, k) = 0.0
167       snow(i) = 0.0            d_ql(i, k) = 0.0
168    END DO            rneb(i, k) = 0.0
169              cldliq(i, k) = 0.0
170    ! Initialiser le flux de precipitation a zero            frac_nucl(i, k) = 1.
171              frac_impa(i, k) = 1.
172    DO i = 1, klon         END DO
173       zrfl(i) = 0.0      END DO
174       zneb(i) = seuil_neb      DO i = 1, klon
175    END DO         rain(i) = 0.0
176           snow(i) = 0.0
177        END DO
178    !AA Pour plus de securite  
179        ! Initialiser le flux de precipitation a zero
180    zalpha_tr = 0.  
181    zfrac_lessi = 0.      DO i = 1, klon
182           zrfl(i) = 0.0
183    !AA----------------------------------------------------------         zneb(i) = seuil_neb
184        END DO
185    ! Boucle verticale (du haut vers le bas)  
186        ! Pour plus de securite
187    !IM : klevm1  
188    klevm1 = klev - 1      zalpha_tr = 0.
189    DO  k = klev, 1, -1      zfrac_lessi = 0.
190    
191       !AA----------------------------------------------------------      loop_vertical: DO k = klev, 1, -1
192           DO i = 1, klon
193       DO i = 1, klon            zt(i) = t(i, k)
194          zt(i) = t(i,k)            zq(i) = q(i, k)
195          zq(i) = q(i,k)         END DO
196       END DO  
197           ! Calculer la varition de temp. de l'air du a la chaleur sensible
198       ! Calculer la varition de temp. de l'air du a la chaleur sensible         ! transporter par la pluie.
199       ! transporter par la pluie.         ! Il resterait a rajouter cet effet de la chaleur sensible sur les
200       ! Il resterait a rajouter cet effet de la chaleur sensible sur les         ! flux de surface, du a la diff. de temp. entre le 1er niveau et la
201       ! flux de surface, du a la diff. de temp. entre le 1er niveau et la         ! surface.
202       ! surface.  
203           DO i = 1, klon
204       DO i = 1, klon            IF (k <= klev - 1) THEN
205          IF (k<=klevm1) THEN               zmair = (paprs(i, k)-paprs(i, k+1))/rg
206             zmair = (paprs(i,k)-paprs(i,k+1))/rg               zcpair = rcpd*(1.0+rvtmp2*zq(i))
207             zcpair = rcpd*(1.0+rvtmp2*zq(i))               zcpeau = rcpd*rvtmp2
208             zcpeau = rcpd*rvtmp2               zt(i) = ((t(i, k + 1) + d_t(i, k + 1)) * zrfl(i) * dtphys &
209             zt(i) = ((t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau+zmair*zcpair* &                    * zcpeau + zmair * zcpair* zt(i)) &
210                  zt(i))/(zmair*zcpair+zrfl(i)*dtime*zcpeau)                    / (zmair * zcpair + zrfl(i) * dtphys * zcpeau)
211             !C        WRITE (6,*) 'cppluie ', zt(i)-(t(i,k+1)+d_t(i,k+1))            END IF
212          END IF         END DO
213       END DO  
214           IF (evap_prec) THEN
215       ! Calculer l'evaporation de la precipitation            ! Calculer l'evaporation de la precipitation
216              DO i = 1, klon
217                 IF (zrfl(i)>0.) THEN
218                    zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)
219       IF (evap_prec) THEN                  zqs(i) = min(0.5, zqs(i))
220          DO i = 1, klon                  zcor = 1./(1.-retv*zqs(i))
221             IF (zrfl(i)>0.) THEN                  zqs(i) = zqs(i)*zcor
222                IF (thermcep) THEN                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))
223                   zdelta = max(0.,sign(1.,rtt-zt(i)))                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &
224                   zqs(i) = r2es*foeew(zt(i),zdelta)/pplay(i,k)                       (paprs(i, k)-paprs(i, k+1))/pplay(i, k)*zt(i)*rd/rg
225                   zqs(i) = min(0.5,zqs(i))                  zqevt = max(0.0, min(zqevt, zrfl(i)))*rg*dtphys/ &
226                   zcor = 1./(1.-retv*zqs(i))                       (paprs(i, k)-paprs(i, k+1))
227                   zqs(i) = zqs(i)*zcor                  zqev = min(zqev, zqevt)
228                ELSE                  zrfln(i) = zrfl(i) - zqev*(paprs(i, k)-paprs(i, k+1))/rg/dtphys
229                   IF (zt(i)<t_coup) THEN  
230                      zqs(i) = qsats(zt(i))/pplay(i,k)                  ! pour la glace, on r\'e\'evapore toute la pr\'ecip dans la
231                   ELSE                  ! couche du dessous la glace venant de la couche du
232                      zqs(i) = qsatl(zt(i))/pplay(i,k)                  ! dessus est simplement dans la couche du dessous.
233                   END IF  
234                END IF                  IF (zt(i)<t_coup .AND. reevap_ice) zrfln(i) = 0.
235                zqev = max(0.0,(zqs(i)-zq(i))*zneb(i))  
236                zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &                  zq(i) = zq(i) - (zrfln(i)-zrfl(i))*(rg/(paprs(i, k)-paprs(i, &
237                     (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*rd/rg                       k+1)))*dtphys
238                zqevt = max(0.0,min(zqevt,zrfl(i)))*rg*dtime/ &                  zt(i) = zt(i) + (zrfln(i)-zrfl(i))*(rg/(paprs(i, k)-paprs(i, &
239                     (paprs(i,k)-paprs(i,k+1))                       k+1)))*dtphys*rlvtt/rcpd/(1.0+rvtmp2*zq(i))
240                zqev = min(zqev,zqevt)                  zrfl(i) = zrfln(i)
241                zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))/rg/dtime               END IF
242              END DO
243                ! pour la glace, on réévapore toute la précip dans la couche du dessous         END IF
244                ! la glace venant de la couche du dessus est simplement dans la couche  
245                ! du dessous.         ! Calculer Qs et L/Cp*dQs/dT:
246    
247                IF (zt(i)<t_coup .AND. reevap_ice) zrfln(i) = 0.         DO i = 1, klon
248              zdelta = rtt >= zt(i)
249                zq(i) = zq(i) - (zrfln(i)-zrfl(i))*(rg/(paprs(i,k)-paprs(i, &            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
250                     k+1)))*dtime            zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))
251                zt(i) = zt(i) + (zrfln(i)-zrfl(i))*(rg/(paprs(i,k)-paprs(i, &            zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
252                     k+1)))*dtime*rlvtt/rcpd/(1.0+rvtmp2*zq(i))            zqs(i) = min(0.5, zqs(i))
253                zrfl(i) = zrfln(i)            zcor = 1./(1.-retv*zqs(i))
254             END IF            zqs(i) = zqs(i)*zcor
255          END DO            zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)
256       END IF         END DO
257    
258       ! Calculer Qs et L/Cp*dQs/dT:         ! Determiner la condensation partielle et calculer la quantite
259           ! de l'eau condensee:
260       IF (thermcep) THEN  
261          DO i = 1, klon         IF (cpartiel) THEN
262             zdelta = max(0.,sign(1.,rtt-zt(i)))            ! Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
263             zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta            ! nuageuse a partir des PDF de Sandrine Bony.
264             zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))            ! rneb : fraction nuageuse
265             zqs(i) = r2es*foeew(zt(i),zdelta)/pplay(i,k)            ! zqn : eau totale dans le nuage
266             zqs(i) = min(0.5,zqs(i))            ! zcond : eau condensee moyenne dans la maille.
267             zcor = 1./(1.-retv*zqs(i))  
268             zqs(i) = zqs(i)*zcor            ! on prend en compte le r\'echauffement qui diminue
269             zdqs(i) = foede(zt(i),zdelta,zcvm5,zqs(i),zcor)            ! la partie condens\'ee
270          END DO  
271       ELSE            ! Version avec les ratqs
272          DO i = 1, klon  
273             IF (zt(i)<t_coup) THEN            IF (iflag_pdf==0) THEN
274                zqs(i) = qsats(zt(i))/pplay(i,k)               DO i = 1, klon
275                zdqs(i) = dqsats(zt(i),zqs(i))                  zdelq = min(ratqs(i, k), 0.99)*zq(i)
276             ELSE                  rneb(i, k) = (zq(i)+zdelq-zqs(i))/(2.0*zdelq)
277                zqs(i) = qsatl(zt(i))/pplay(i,k)                  zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
278                zdqs(i) = dqsatl(zt(i),zqs(i))               END DO
279             END IF            ELSE
280          END DO               ! Version avec les nouvelles PDFs.
281       END IF               DO i = 1, klon
282                    IF (zq(i) < 1E-15) THEN
283       ! Determiner la condensation partielle et calculer la quantite                     zq(i) = 1E-15
284       ! de l'eau condensee:                  END IF
285                 END DO
286       IF (cpartiel) THEN               DO i = 1, klon
287                    zpdf_sig(i) = ratqs(i, k)*zq(i)
288          !        print*,'Dans partiel k=',k                  zpdf_k(i) = -sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
289                    zpdf_delta(i) = log(zq(i)/zqs(i))
290          !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau                  zpdf_a(i) = zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
291          !   nuageuse a partir des PDF de Sandrine Bony.                  zpdf_b(i) = zpdf_k(i)/(2.*sqrt(2.))
292          !   rneb  : fraction nuageuse                  zpdf_e1(i) = zpdf_a(i) - zpdf_b(i)
293          !   zqn   : eau totale dans le nuage                  zpdf_e1(i) = sign(min(abs(zpdf_e1(i)), 5.), zpdf_e1(i))
294          !   zcond : eau condensee moyenne dans la maille.                  zpdf_e1(i) = 1. - nr_erf(zpdf_e1(i))
295          !           on prend en compte le réchauffement qui diminue la partie condensee                  zpdf_e2(i) = zpdf_a(i) + zpdf_b(i)
296                    zpdf_e2(i) = sign(min(abs(zpdf_e2(i)), 5.), zpdf_e2(i))
297          !   Version avec les raqts                  zpdf_e2(i) = 1. - nr_erf(zpdf_e2(i))
298                    IF (zpdf_e1(i)<1.E-10) THEN
299          IF (iflag_pdf==0) THEN                     rneb(i, k) = 0.
300                       zqn(i) = zqs(i)
301             DO i = 1, klon                  ELSE
302                zdelq = min(ratqs(i,k),0.99)*zq(i)                     rneb(i, k) = 0.5*zpdf_e1(i)
303                rneb(i,k) = (zq(i)+zdelq-zqs(i))/(2.0*zdelq)                     zqn(i) = zq(i)*zpdf_e2(i)/zpdf_e1(i)
304                zqn(i) = (zq(i)+zdelq+zqs(i))/2.0                  END IF
305             END DO               END DO
306              END IF
307          ELSE  
308              DO i = 1, klon
309             !   Version avec les nouvelles PDFs.               IF (rneb(i, k)<=0.0) zqn(i) = 0.0
310             DO i = 1, klon               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)
311                IF (zq(i)<1.E-15) THEN               rneb(i, k) = max(0., min(1., rneb(i, k)))
312                   !C Lionel GUEZ                print*,'ZQ(',i,',',k,')=',zq(i)               ! On ne divise pas par 1 + zdqs pour forcer \`a avoir l'eau
313                   zq(i) = 1.E-15               ! pr\'edite par la convection. Attention : il va falloir
314                END IF               ! verifier tout ca.
315             END DO               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)
316             DO i = 1, klon               rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)
317                zpdf_sig(i) = ratqs(i,k)*zq(i)               IF (rneb(i, k) <= 0.) rhcl(i, k) = zq(i) / zqs(i)
318                zpdf_k(i) = -sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))               IF (rneb(i, k) >= 1.) rhcl(i, k) = 1.
319                zpdf_delta(i) = log(zq(i)/zqs(i))            END DO
320                zpdf_a(i) = zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))         ELSE
321                zpdf_b(i) = zpdf_k(i)/(2.*sqrt(2.))            DO i = 1, klon
322                zpdf_e1(i) = zpdf_a(i) - zpdf_b(i)               IF (zq(i)>zqs(i)) THEN
323                zpdf_e1(i) = sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))                  rneb(i, k) = 1.0
324                zpdf_e1(i) = 1. - erf(zpdf_e1(i))               ELSE
325                zpdf_e2(i) = zpdf_a(i) + zpdf_b(i)                  rneb(i, k) = 0.0
326                zpdf_e2(i) = sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))               END IF
327                zpdf_e2(i) = 1. - erf(zpdf_e2(i))               zcond(i) = max(0.0, zq(i)-zqs(i))/(1.+zdqs(i))
328                IF (zpdf_e1(i)<1.E-10) THEN            END DO
329                   rneb(i,k) = 0.         END IF
330                   zqn(i) = zqs(i)  
331                ELSE         DO i = 1, klon
332                   rneb(i,k) = 0.5*zpdf_e1(i)            zq(i) = zq(i) - zcond(i)
333                   zqn(i) = zq(i)*zpdf_e2(i)/zpdf_e1(i)            zt(i) = zt(i) + zcond(i)*rlvtt/rcpd/(1.0+rvtmp2*zq(i))
334                END IF         END DO
335    
336             END DO         ! Partager l'eau condensee en precipitation et eau liquide nuageuse
337    
338           DO i = 1, klon
339          END IF            IF (rneb(i, k)>0.0) THEN
340          ! iflag_pdf                                                             zoliq(i) = zcond(i)
341          DO i = 1, klon               zrho(i) = pplay(i, k)/zt(i)/rd
342             IF (rneb(i,k)<=0.0) zqn(i) = 0.0               zdz(i) = (paprs(i, k)-paprs(i, k+1))/(zrho(i)*rg)
343             IF (rneb(i,k)>=1.0) zqn(i) = zq(i)               zfice(i) = 1.0 - (zt(i)-ztglace)/(273.13-ztglace)
344             rneb(i,k) = max(0.0,min(1.0,rneb(i,k)))               zfice(i) = min(max(zfice(i), 0.0), 1.0)
345             !           zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))               zfice(i) = zfice(i)**nexpo
346             !  On ne divise pas par 1+zdqs pour forcer a avoir l'eau predite par               zneb(i) = max(rneb(i, k), seuil_neb)
347             !  la convection.               cldliq(i, k) = zoliq(i)/real(ninter+1)
348             !  ATTENTION !!! Il va falloir verifier tout ca.            END IF
349             zcond(i) = max(0.0,zqn(i)-zqs(i))*rneb(i,k)         END DO
350             !           print*,'ZDQS ',zdqs(i)  
351             !--Olivier         DO n = 1, ninter
352             rhcl(i,k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)            DO i = 1, klon
353             IF (rneb(i,k)<=0.0) rhcl(i,k) = zq(i)/zqs(i)               IF (rneb(i, k)>0.0) THEN
354             IF (rneb(i,k)>=1.0) rhcl(i,k) = 1.0                  zrhol(i) = zrho(i)*zoliq(i)/zneb(i)
355             !--fin  
356          END DO                  IF (ptconv(i, k)) THEN
357       ELSE                     zcl(i) = cld_lc_con
358          DO i = 1, klon                     zct(i) = 1./cld_tau_con
359             IF (zq(i)>zqs(i)) THEN                  ELSE
360                rneb(i,k) = 1.0                     zcl(i) = cld_lc_lsc
361             ELSE                     zct(i) = 1./cld_tau_lsc
362                rneb(i,k) = 0.0                  END IF
363             END IF                  ! quantit\'e d'eau \`a \'eliminer
364             zcond(i) = max(0.0,zq(i)-zqs(i))/(1.+zdqs(i))                  zchau(i) = zct(i)*dtphys/real(ninter)*zoliq(i)* &
365          END DO                       (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i))
366       END IF                  ! m\^eme chose pour la glace
367                    IF (ptconv(i, k)) THEN
368       DO i = 1, klon                     zfroi(i) = dtphys/real(ninter)/zdz(i)*zoliq(i)* &
369          zq(i) = zq(i) - zcond(i)                          fallvc(zrhol(i))*zfice(i)
370          !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD                  ELSE
371          zt(i) = zt(i) + zcond(i)*rlvtt/rcpd/(1.0+rvtmp2*zq(i))                     zfroi(i) = dtphys/real(ninter)/zdz(i)*zoliq(i)* &
372       END DO                          fallvs(zrhol(i))*zfice(i)
373                    END IF
374       ! Partager l'eau condensee en precipitation et eau liquide nuageuse                  ztot(i) = zchau(i) + zfroi(i)
375                    IF (zneb(i)==seuil_neb) ztot(i) = 0.0
376       DO i = 1, klon                  ztot(i) = min(max(ztot(i), 0.0), zoliq(i))
377          IF (rneb(i,k)>0.0) THEN                  zoliq(i) = max(zoliq(i)-ztot(i), 0.0)
378             zoliq(i) = zcond(i)                  cldliq(i, k) = cldliq(i, k) + zoliq(i)/real(ninter+1)
379             zrho(i) = pplay(i,k)/zt(i)/rd               END IF
380             zdz(i) = (paprs(i,k)-paprs(i,k+1))/(zrho(i)*rg)            END DO
381             zfice(i) = 1.0 - (zt(i)-ztglace)/(273.13-ztglace)         END DO
382             zfice(i) = min(max(zfice(i),0.0),1.0)  
383             zfice(i) = zfice(i)**nexpo         DO i = 1, klon
384             zneb(i) = max(rneb(i,k),seuil_neb)            IF (rneb(i, k)>0.0) THEN
385             radliq(i,k) = zoliq(i)/float(ninter+1)               d_ql(i, k) = zoliq(i)
386          END IF               zrfl(i) = zrfl(i) + max(zcond(i) - zoliq(i), 0.) &
387       END DO                    * (paprs(i, k) - paprs(i, k + 1)) / (rg * dtphys)
388              END IF
389       DO n = 1, ninter            IF (zt(i)<rtt) THEN
390          DO i = 1, klon               psfl(i, k) = zrfl(i)
391             IF (rneb(i,k)>0.0) THEN            ELSE
392                zrhol(i) = zrho(i)*zoliq(i)/zneb(i)               prfl(i, k) = zrfl(i)
393              END IF
394                IF (ptconv(i,k)) THEN         END DO
395                   zcl(i) = cld_lc_con  
396                   zct(i) = 1./cld_tau_con         ! Calculer les tendances de q et de t :
397                ELSE         DO i = 1, klon
398                   zcl(i) = cld_lc_lsc            d_q(i, k) = zq(i) - q(i, k)
399                   zct(i) = 1./cld_tau_lsc            d_t(i, k) = zt(i) - t(i, k)
400                END IF         END DO
401                !  quantité d'eau à élminier.  
402                zchau(i) = zct(i)*dtime/float(ninter)*zoliq(i)* &         ! Calcul du lessivage stratiforme
403                     (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i))         DO i = 1, klon
404                !  meme chose pour la glace.            zprec_cond(i) = max(zcond(i) - zoliq(i), 0.0) &
405                IF (ptconv(i,k)) THEN                 * (paprs(i, k)-paprs(i, k+1))/rg
406                   zfroi(i) = dtime/float(ninter)/zdz(i)*zoliq(i)* &            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN
407                        fallvc(zrhol(i))*zfice(i)               ! lessivage nucleation LMD5 dans la couche elle-meme
408                ELSE               IF (t(i, k)>=ztglace) THEN
409                   zfroi(i) = dtime/float(ninter)/zdz(i)*zoliq(i)* &                  zalpha_tr = a_tr_sca(3)
410                        fallvs(zrhol(i))*zfice(i)               ELSE
411                END IF                  zalpha_tr = a_tr_sca(4)
412                ztot(i) = zchau(i) + zfroi(i)               END IF
413                IF (zneb(i)==seuil_neb) ztot(i) = 0.0               zfrac_lessi = 1. - exp(zalpha_tr*zprec_cond(i)/zneb(i))
414                ztot(i) = min(max(ztot(i),0.0),zoliq(i))               pfrac_nucl(i, k) = pfrac_nucl(i, k)*(1.-zneb(i)*zfrac_lessi)
415                zoliq(i) = max(zoliq(i)-ztot(i),0.0)               frac_nucl(i, k) = 1. - zneb(i)*zfrac_lessi
416                radliq(i,k) = radliq(i,k) + zoliq(i)/float(ninter+1)  
417             END IF               ! nucleation avec un facteur -1 au lieu de -0.5
418          END DO               zfrac_lessi = 1. - exp(-zprec_cond(i)/zneb(i))
419       END DO               pfrac_1nucl(i, k) = pfrac_1nucl(i, k)*(1.-zneb(i)*zfrac_lessi)
420              END IF
421       DO i = 1, klon         END DO
422          IF (rneb(i,k)>0.0) THEN  
423             d_ql(i,k) = zoliq(i)         ! Lessivage par impaction dans les couches en-dessous
424             zrfl(i) = zrfl(i) + max(zcond(i)-zoliq(i),0.0)*(paprs(i,k)-paprs(i &         ! boucle sur i
425                  ,k+1))/(rg*dtime)         DO kk = k - 1, 1, -1
426          END IF            DO i = 1, klon
427          IF (zt(i)<rtt) THEN               IF (rneb(i, k)>0. .AND. zprec_cond(i)>0.) THEN
428             psfl(i,k) = zrfl(i)                  IF (t(i, kk)>=ztglace) THEN
429          ELSE                     zalpha_tr = a_tr_sca(1)
430             prfl(i,k) = zrfl(i)                  ELSE
431          END IF                     zalpha_tr = a_tr_sca(2)
432       END DO                  END IF
433                    zfrac_lessi = 1. - exp(zalpha_tr*zprec_cond(i)/zneb(i))
434       ! Calculer les tendances de q et de t:                  pfrac_impa(i, kk) = pfrac_impa(i, kk)*(1.-zneb(i)*zfrac_lessi)
435                    frac_impa(i, kk) = 1. - zneb(i)*zfrac_lessi
436       DO i = 1, klon               END IF
437          d_q(i,k) = zq(i) - q(i,k)            END DO
438          d_t(i,k) = zt(i) - t(i,k)         END DO
439       END DO      end DO loop_vertical
440    
441       !AA--------------- Calcul du lessivage stratiforme  -------------      ! Pluie ou neige au sol selon la temperature de la 1ere couche
442    
443       DO i = 1, klon      DO i = 1, klon
444          zprec_cond(i) = max(zcond(i)-zoliq(i),0.0)* &         IF ((t(i, 1)+d_t(i, 1))<rtt) THEN
445               (paprs(i,k)-paprs(i,k+1))/rg            snow(i) = zrfl(i)
446          IF (rneb(i,k)>0.0 .AND. zprec_cond(i)>0.) THEN            zlh_solid(i) = rlstt - rlvtt
447             !AA lessivage nucleation LMD5 dans la couche elle-meme         ELSE
448             IF (t(i,k)>=ztglace) THEN            rain(i) = zrfl(i)
449                zalpha_tr = a_tr_sca(3)            zlh_solid(i) = 0.
450             ELSE         END IF
451                zalpha_tr = a_tr_sca(4)      END DO
452             END IF  
453             zfrac_lessi = 1. - exp(zalpha_tr*zprec_cond(i)/zneb(i))      ! For energy conservation: when snow is present, the solification
454             pfrac_nucl(i,k) = pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)      ! latent heat is considered.
455             frac_nucl(i,k) = 1. - zneb(i)*zfrac_lessi      DO k = 1, klev
456           DO i = 1, klon
457             ! nucleation avec un facteur -1 au lieu de -0.5            zcpair = rcpd*(1.0+rvtmp2*(q(i, k)+d_q(i, k)))
458             zfrac_lessi = 1. - exp(-zprec_cond(i)/zneb(i))            zmair = (paprs(i, k)-paprs(i, k+1))/rg
459             pfrac_1nucl(i,k) = pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)            zm_solid = (prfl(i, k)-prfl(i, k+1)+psfl(i, k)-psfl(i, k+1))*dtphys
460          END IF            d_t(i, k) = d_t(i, k) + zlh_solid(i)*zm_solid/(zcpair*zmair)
461           END DO
462        END DO
463       END DO  
464       !AA Lessivage par impaction dans les couches en-dessous    contains
465       ! boucle sur i                                          
466       DO kk = k - 1, 1, -1      ! vitesse de chute pour cristaux de glace
467          DO i = 1, klon  
468             IF (rneb(i,k)>0.0 .AND. zprec_cond(i)>0.) THEN      REAL function fallvs(zzz)
469                IF (t(i,kk)>=ztglace) THEN        REAL, intent(in):: zzz
470                   zalpha_tr = a_tr_sca(1)        fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
471                ELSE      end function fallvs
472                   zalpha_tr = a_tr_sca(2)  
473                END IF      !********************************************************
474                zfrac_lessi = 1. - exp(zalpha_tr*zprec_cond(i)/zneb(i))  
475                pfrac_impa(i,kk) = pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)      real function fallvc(zzz)
476                frac_impa(i,kk) = 1. - zneb(i)*zfrac_lessi        REAL, intent(in):: zzz
477             END IF        fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
478          END DO      end function fallvc
      END DO  
   
      !AA----------------------------------------------------------  
      !                     FIN DE BOUCLE SUR K  
   end DO  
   
   !AA-----------------------------------------------------------  
   
   ! Pluie ou neige au sol selon la temperature de la 1ere couche  
   
   DO i = 1, klon  
      IF ((t(i,1)+d_t(i,1))<rtt) THEN  
         snow(i) = zrfl(i)  
         zlh_solid(i) = rlstt - rlvtt  
      ELSE  
         rain(i) = zrfl(i)  
         zlh_solid(i) = 0.  
      END IF  
   END DO  
   
   ! For energy conservation : when snow is present, the solification  
   ! latent heat is considered.  
   DO k = 1, klev  
      DO i = 1, klon  
         zcpair = rcpd*(1.0+rvtmp2*(q(i,k)+d_q(i,k)))  
         zmair = (paprs(i,k)-paprs(i,k+1))/rg  
         zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime  
         d_t(i,k) = d_t(i,k) + zlh_solid(i)*zm_solid/(zcpair*zmair)  
      END DO  
   END DO  
479    
480  END SUBROUTINE fisrtilp    END SUBROUTINE fisrtilp
481    
482    end module fisrtilp_m
Legend:
Removed from v.22  
changed lines
  Added in v.339
  ViewVC Help
Powered by ViewVC 1.1.21