/[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/phylmd/fisrtilp.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC trunk/phylmd/fisrtilp.f revision 298 by guez, Thu Jul 26 16:45:51 2018 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, &         radliq, 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 87  contains Line 85  contains
85      PARAMETER (t_coup=234.0)      PARAMETER (t_coup=234.0)
86    
87      INTEGER i, k, n, kk      INTEGER i, k, n, kk
88      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5      REAL zqs(klon), zdqs(klon), zcor, zcvm5
89        logical zdelta
90      REAL zrfl(klon), zrfln(klon), zqev, zqevt      REAL zrfl(klon), zrfln(klon), zqev, zqevt
91      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
92      REAL ztglace, zt(klon)      REAL ztglace, zt(klon)
# Line 112  contains Line 111  contains
111      ! Pour la conversion eau-neige      ! Pour la conversion eau-neige
112      REAL zlh_solid(klon), zm_solid      REAL zlh_solid(klon), zm_solid
113    
     ! Fonctions en ligne:  
   
     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      !---------------------------------------------------------------      !---------------------------------------------------------------
115    
116      zdelq = 0.0      zdelq = 0.0
# Line 128  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 214  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 224  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                     zdelta = max(0., sign(1., rtt-zt(i)))                  zqs(i) = min(0.5, zqs(i))
220                     zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)                  zcor = 1./(1.-retv*zqs(i))
221                     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  
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 262  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 = max(0., sign(1., rtt-zt(i)))            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
250               zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*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 295  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 339  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 390  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)
# Line 414  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 423  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 431  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 486  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
465    
466        ! vitesse de chute pour cristaux de glace
467    
468        REAL function fallvs(zzz)
469          REAL, intent(in):: zzz
470          fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
471        end function fallvs
472    
473        !********************************************************
474    
475        real function fallvc(zzz)
476          REAL, intent(in):: zzz
477          fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
478        end function fallvc
479    
480    END SUBROUTINE fisrtilp    END SUBROUTINE fisrtilp
481    
482  end module fisrtilp_m  end module fisrtilp_m
Legend:
Removed from v.78  
changed lines
  Added in v.298
  ViewVC Help
Powered by ViewVC 1.1.21