/[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/Sources/phylmd/fisrtilp.f revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC trunk/phylmd/fisrtilp.f90 revision 339 by guez, Thu Sep 26 17:08:42 2019 UTC
# Line 4  module fisrtilp_m Line 4  module fisrtilp_m
4    
5  contains  contains
6    
7    SUBROUTINE fisrtilp(dtime, paprs, pplay, t, q, ptconv, ratqs, d_t, d_q, &    SUBROUTINE fisrtilp(paprs, pplay, t, q, ptconv, ratqs, d_t, d_q, d_ql, rneb, &
8         d_ql, rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, &         cldliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, &
9         frac_impa, frac_nucl, prfl, psfl, rhcl)         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      ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995      ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995
     ! Other authors: Olivier, AA, IM, YM, MAF  
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    
17        USE numer_rec_95, ONLY: nr_erf
18    
19        use comconst, only: dtphys
20      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &
21           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
22      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
23      USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foede, foeew
     USE numer_rec_95, ONLY: nr_erf  
24      USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt      USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt
25      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
26    
     ! Arguments:  
   
     REAL, INTENT (IN):: dtime ! intervalle du temps (s)  
27      REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche      REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche
28      REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche      REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche
29      REAL, INTENT (IN):: t(klon, klev) ! temperature (K)      REAL, INTENT (IN):: t(klon, klev) ! temperature (K)
# Line 40  contains Line 38  contains
38      REAL, INTENT (out):: d_ql(klon, klev) ! incrementation de l'eau liquide      REAL, INTENT (out):: d_ql(klon, klev) ! incrementation de l'eau liquide
39      REAL, INTENT (out):: rneb(klon, klev) ! fraction nuageuse      REAL, INTENT (out):: rneb(klon, klev) ! fraction nuageuse
40    
41      REAL, INTENT (out):: radliq(klon, klev)      REAL, INTENT (out):: cldliq(klon, klev)
42      ! eau liquide utilisee dans rayonnement      ! eau liquide utilisee dans rayonnement
43    
44      REAL, INTENT (out):: rain(klon) ! pluies (mm/s)      REAL, INTENT (out):: rain(klon) ! pluies (mm/s)
# Line 121  contains Line 119  contains
119         PRINT *, 'fisrtilp, ninter:', ninter         PRINT *, 'fisrtilp, ninter:', ninter
120         PRINT *, 'fisrtilp, evap_prec:', evap_prec         PRINT *, 'fisrtilp, evap_prec:', evap_prec
121         PRINT *, 'fisrtilp, cpartiel:', cpartiel         PRINT *, 'fisrtilp, cpartiel:', cpartiel
122         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN         IF (abs(dtphys / real(ninter) - 360.) > 0.001) THEN
123            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", dtphys
124            PRINT *, 'Je préfère un sous-intervalle de 6 minutes.'            PRINT *, "Je pr\'ef\`ere un sous-intervalle de 6 minutes."
125         END IF         END IF
126         appel1er = .FALSE.         appel1er = .FALSE.
127    
# Line 168  contains Line 166  contains
166            d_q(i, k) = 0.0            d_q(i, k) = 0.0
167            d_ql(i, k) = 0.0            d_ql(i, k) = 0.0
168            rneb(i, k) = 0.0            rneb(i, k) = 0.0
169            radliq(i, k) = 0.0            cldliq(i, k) = 0.0
170            frac_nucl(i, k) = 1.            frac_nucl(i, k) = 1.
171            frac_impa(i, k) = 1.            frac_impa(i, k) = 1.
172         END DO         END DO
# Line 207  contains Line 205  contains
205               zmair = (paprs(i, k)-paprs(i, k+1))/rg               zmair = (paprs(i, k)-paprs(i, k+1))/rg
206               zcpair = rcpd*(1.0+rvtmp2*zq(i))               zcpair = rcpd*(1.0+rvtmp2*zq(i))
207               zcpeau = rcpd*rvtmp2               zcpeau = rcpd*rvtmp2
208               zt(i) = ((t(i, k + 1) + d_t(i, k + 1)) * zrfl(i) * dtime &               zt(i) = ((t(i, k + 1) + d_t(i, k + 1)) * zrfl(i) * dtphys &
209                    * zcpeau + zmair * zcpair* zt(i)) &                    * zcpeau + zmair * zcpair* zt(i)) &
210                    / (zmair * zcpair + zrfl(i) * dtime * zcpeau)                    / (zmair * zcpair + zrfl(i) * dtphys * zcpeau)
211            END IF            END IF
212         END DO         END DO
213    
# Line 217  contains Line 215  contains
215            ! Calculer l'evaporation de la precipitation            ! Calculer l'evaporation de la precipitation
216            DO i = 1, klon            DO i = 1, klon
217               IF (zrfl(i)>0.) THEN               IF (zrfl(i)>0.) THEN
218                  IF (thermcep) THEN                  zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)
219                     zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)                  zqs(i) = min(0.5, zqs(i))
220                     zqs(i) = min(0.5, zqs(i))                  zcor = 1./(1.-retv*zqs(i))
221                     zcor = 1./(1.-retv*zqs(i))                  zqs(i) = zqs(i)*zcor
                    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  
222                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))
223                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &
224                       (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
225                  zqevt = max(0.0, min(zqevt, zrfl(i)))*rg*dtime/ &                  zqevt = max(0.0, min(zqevt, zrfl(i)))*rg*dtphys/ &
226                       (paprs(i, k)-paprs(i, k+1))                       (paprs(i, k)-paprs(i, k+1))
227                  zqev = min(zqev, zqevt)                  zqev = min(zqev, zqevt)
228                  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/dtphys
229    
230                  ! 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
231                  ! couche du dessous la glace venant de la couche du                  ! couche du dessous la glace venant de la couche du
232                  ! dessus est simplement dans la couche du dessous.                  ! dessus est simplement dans la couche du dessous.
233    
234                  IF (zt(i)<t_coup .AND. reevap_ice) zrfln(i) = 0.                  IF (zt(i)<t_coup .AND. reevap_ice) zrfln(i) = 0.
235    
236                  zq(i) = zq(i) - (zrfln(i)-zrfl(i))*(rg/(paprs(i, k)-paprs(i, &                  zq(i) = zq(i) - (zrfln(i)-zrfl(i))*(rg/(paprs(i, k)-paprs(i, &
237                       k+1)))*dtime                       k+1)))*dtphys
238                  zt(i) = zt(i) + (zrfln(i)-zrfl(i))*(rg/(paprs(i, k)-paprs(i, &                  zt(i) = zt(i) + (zrfln(i)-zrfl(i))*(rg/(paprs(i, k)-paprs(i, &
239                       k+1)))*dtime*rlvtt/rcpd/(1.0+rvtmp2*zq(i))                       k+1)))*dtphys*rlvtt/rcpd/(1.0+rvtmp2*zq(i))
240                  zrfl(i) = zrfln(i)                  zrfl(i) = zrfln(i)
241               END IF               END IF
242            END DO            END DO
# Line 254  contains Line 244  contains
244    
245         ! Calculer Qs et L/Cp*dQs/dT:         ! Calculer Qs et L/Cp*dQs/dT:
246    
247         IF (thermcep) THEN         DO i = 1, klon
248            DO i = 1, klon            zdelta = rtt >= zt(i)
249               zdelta = rtt >= zt(i)            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
250               zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)            zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))
251               zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))            zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
252               zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)            zqs(i) = min(0.5, zqs(i))
253               zqs(i) = min(0.5, zqs(i))            zcor = 1./(1.-retv*zqs(i))
254               zcor = 1./(1.-retv*zqs(i))            zqs(i) = zqs(i)*zcor
255               zqs(i) = zqs(i)*zcor            zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)
256               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  
257    
258         ! Determiner la condensation partielle et calculer la quantite         ! Determiner la condensation partielle et calculer la quantite
259         ! de l'eau condensee:         ! de l'eau condensee:
# Line 287  contains Line 265  contains
265            ! zqn : eau totale dans le nuage            ! zqn : eau totale dans le nuage
266            ! zcond : eau condensee moyenne dans la maille.            ! zcond : eau condensee moyenne dans la maille.
267    
268            ! on prend en compte le réchauffement qui diminue            ! on prend en compte le r\'echauffement qui diminue
269            ! la partie condensée            ! la partie condens\'ee
270    
271            ! Version avec les ratqs            ! Version avec les ratqs
272    
# Line 331  contains Line 309  contains
309               IF (rneb(i, k)<=0.0) zqn(i) = 0.0               IF (rneb(i, k)<=0.0) zqn(i) = 0.0
310               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)
311               rneb(i, k) = max(0., min(1., rneb(i, k)))               rneb(i, k) = max(0., min(1., rneb(i, k)))
312               ! On ne divise pas par 1 + zdqs pour forcer à avoir l'eau               ! On ne divise pas par 1 + zdqs pour forcer \`a avoir l'eau
313               ! prédite par la convection. Attention : il va falloir               ! pr\'edite par la convection. Attention : il va falloir
314               ! verifier tout ca.               ! verifier tout ca.
315               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)
316               rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)               rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i)
# Line 366  contains Line 344  contains
344               zfice(i) = min(max(zfice(i), 0.0), 1.0)               zfice(i) = min(max(zfice(i), 0.0), 1.0)
345               zfice(i) = zfice(i)**nexpo               zfice(i) = zfice(i)**nexpo
346               zneb(i) = max(rneb(i, k), seuil_neb)               zneb(i) = max(rneb(i, k), seuil_neb)
347               radliq(i, k) = zoliq(i)/real(ninter+1)               cldliq(i, k) = zoliq(i)/real(ninter+1)
348            END IF            END IF
349         END DO         END DO
350    
# Line 382  contains Line 360  contains
360                     zcl(i) = cld_lc_lsc                     zcl(i) = cld_lc_lsc
361                     zct(i) = 1./cld_tau_lsc                     zct(i) = 1./cld_tau_lsc
362                  END IF                  END IF
363                  ! quantité d'eau à élminier.                  ! quantit\'e d'eau \`a \'eliminer
364                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &                  zchau(i) = zct(i)*dtphys/real(ninter)*zoliq(i)* &
365                       (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))
366                  ! meme chose pour la glace.                  ! m\^eme chose pour la glace
367                  IF (ptconv(i, k)) THEN                  IF (ptconv(i, k)) THEN
368                     zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* &                     zfroi(i) = dtphys/real(ninter)/zdz(i)*zoliq(i)* &
369                          fallvc(zrhol(i))*zfice(i)                          fallvc(zrhol(i))*zfice(i)
370                  ELSE                  ELSE
371                     zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* &                     zfroi(i) = dtphys/real(ninter)/zdz(i)*zoliq(i)* &
372                          fallvs(zrhol(i))*zfice(i)                          fallvs(zrhol(i))*zfice(i)
373                  END IF                  END IF
374                  ztot(i) = zchau(i) + zfroi(i)                  ztot(i) = zchau(i) + zfroi(i)
375                  IF (zneb(i)==seuil_neb) ztot(i) = 0.0                  IF (zneb(i)==seuil_neb) ztot(i) = 0.0
376                  ztot(i) = min(max(ztot(i), 0.0), zoliq(i))                  ztot(i) = min(max(ztot(i), 0.0), zoliq(i))
377                  zoliq(i) = max(zoliq(i)-ztot(i), 0.0)                  zoliq(i) = max(zoliq(i)-ztot(i), 0.0)
378                  radliq(i, k) = radliq(i, k) + zoliq(i)/real(ninter+1)                  cldliq(i, k) = cldliq(i, k) + zoliq(i)/real(ninter+1)
379               END IF               END IF
380            END DO            END DO
381         END DO         END DO
# Line 406  contains Line 384  contains
384            IF (rneb(i, k)>0.0) THEN            IF (rneb(i, k)>0.0) THEN
385               d_ql(i, k) = zoliq(i)               d_ql(i, k) = zoliq(i)
386               zrfl(i) = zrfl(i) + max(zcond(i) - zoliq(i), 0.) &               zrfl(i) = zrfl(i) + max(zcond(i) - zoliq(i), 0.) &
387                    * (paprs(i, k) - paprs(i, k + 1)) / (rg * dtime)                    * (paprs(i, k) - paprs(i, k + 1)) / (rg * dtphys)
388            END IF            END IF
389            IF (zt(i)<rtt) THEN            IF (zt(i)<rtt) THEN
390               psfl(i, k) = zrfl(i)               psfl(i, k) = zrfl(i)
# Line 415  contains Line 393  contains
393            END IF            END IF
394         END DO         END DO
395    
396         ! Calculer les tendances de q et de t:         ! Calculer les tendances de q et de t :
397         DO i = 1, klon         DO i = 1, klon
398            d_q(i, k) = zq(i) - q(i, k)            d_q(i, k) = zq(i) - q(i, k)
399            d_t(i, k) = zt(i) - t(i, k)            d_t(i, k) = zt(i) - t(i, k)
# Line 423  contains Line 401  contains
401    
402         ! Calcul du lessivage stratiforme         ! Calcul du lessivage stratiforme
403         DO i = 1, klon         DO i = 1, klon
404            zprec_cond(i) = max(zcond(i)-zoliq(i), 0.0)* &            zprec_cond(i) = max(zcond(i) - zoliq(i), 0.0) &
405                 (paprs(i, k)-paprs(i, k+1))/rg                 * (paprs(i, k)-paprs(i, k+1))/rg
406            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN
407               ! lessivage nucleation LMD5 dans la couche elle-meme               ! lessivage nucleation LMD5 dans la couche elle-meme
408               IF (t(i, k)>=ztglace) THEN               IF (t(i, k)>=ztglace) THEN
# Line 478  contains Line 456  contains
456         DO i = 1, klon         DO i = 1, klon
457            zcpair = rcpd*(1.0+rvtmp2*(q(i, k)+d_q(i, k)))            zcpair = rcpd*(1.0+rvtmp2*(q(i, k)+d_q(i, k)))
458            zmair = (paprs(i, k)-paprs(i, k+1))/rg            zmair = (paprs(i, k)-paprs(i, k+1))/rg
459            zm_solid = (prfl(i, k)-prfl(i, k+1)+psfl(i, k)-psfl(i, k+1))*dtime            zm_solid = (prfl(i, k)-prfl(i, k+1)+psfl(i, k)-psfl(i, k+1))*dtphys
460            d_t(i, k) = d_t(i, k) + zlh_solid(i)*zm_solid/(zcpair*zmair)            d_t(i, k) = d_t(i, k) + zlh_solid(i)*zm_solid/(zcpair*zmair)
461         END DO         END DO
462      END DO      END DO
463    
464    contains    contains
465    
466      ! vitesse de chute pour crystaux de glace      ! vitesse de chute pour cristaux de glace
467    
468      REAL function fallvs(zzz)      REAL function fallvs(zzz)
469        REAL zzz        REAL, intent(in):: zzz
470        fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc        fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
471      end function fallvs      end function fallvs
472    
473        !********************************************************
474    
475      real function fallvc(zzz)      real function fallvc(zzz)
476        REAL zzz        REAL, intent(in):: zzz
477        fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con        fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
478      end function fallvc      end function fallvc
479    
Legend:
Removed from v.134  
changed lines
  Added in v.339
  ViewVC Help
Powered by ViewVC 1.1.21