/[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/Sources/phylmd/fisrtilp.f revision 213 by guez, Mon Feb 27 15:44:55 2017 UTC
# Line 8  contains Line 8  contains
8         d_ql, rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, &         d_ql, rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, &
9         frac_impa, frac_nucl, prfl, psfl, rhcl)         frac_impa, frac_nucl, prfl, psfl, rhcl)
10    
11      ! From phylmd/fisrtilp.F, version 1.2 2004/11/09 16:55:40      ! From phylmd/fisrtilp.F, version 1.2, 2004/11/09 16:55:40
12      ! 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 comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &
18           cld_tau_lsc, coef_eva, ffallv_con, ffallv_lsc, iflag_pdf, reevap_ice           cld_tau_lsc, coef_eva, ffallv_con, ffallv_lsc, iflag_pdf, reevap_ice
19      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
20      USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats
21      USE numer_rec_95, ONLY: nr_erf      USE numer_rec_95, ONLY: nr_erf
22      USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt      USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt
23      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
24    
     ! Arguments:  
   
25      REAL, INTENT (IN):: dtime ! intervalle du temps (s)      REAL, INTENT (IN):: dtime ! intervalle du temps (s)
26      REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche      REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche
27      REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche      REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche
# Line 87  contains Line 84  contains
84      PARAMETER (t_coup=234.0)      PARAMETER (t_coup=234.0)
85    
86      INTEGER i, k, n, kk      INTEGER i, k, n, kk
87      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5      REAL zqs(klon), zdqs(klon), zcor, zcvm5
88        logical zdelta
89      REAL zrfl(klon), zrfln(klon), zqev, zqevt      REAL zrfl(klon), zrfln(klon), zqev, zqevt
90      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
91      REAL ztglace, zt(klon)      REAL ztglace, zt(klon)
# Line 112  contains Line 110  contains
110      ! Pour la conversion eau-neige      ! Pour la conversion eau-neige
111      REAL zlh_solid(klon), zm_solid      REAL zlh_solid(klon), zm_solid
112    
     ! 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  
   
113      !---------------------------------------------------------------      !---------------------------------------------------------------
114    
115      zdelq = 0.0      zdelq = 0.0
# Line 129  contains Line 119  contains
119         PRINT *, 'fisrtilp, evap_prec:', evap_prec         PRINT *, 'fisrtilp, evap_prec:', evap_prec
120         PRINT *, 'fisrtilp, cpartiel:', cpartiel         PRINT *, 'fisrtilp, cpartiel:', cpartiel
121         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN
122            PRINT *, "fisrtilp : ce n'est pas prévu, voir Z. X. Li", dtime            PRINT *, "fisrtilp : ce n'est pas pr\'evu, voir Z. X. Li", dtime
123            PRINT *, 'Je préfère un sous-intervalle de 6 minutes.'            PRINT *, "Je pr\'ef\`ere un sous-intervalle de 6 minutes."
124         END IF         END IF
125         appel1er = .FALSE.         appel1er = .FALSE.
126    
# Line 224  contains Line 214  contains
214            ! Calculer l'evaporation de la precipitation            ! Calculer l'evaporation de la precipitation
215            DO i = 1, klon            DO i = 1, klon
216               IF (zrfl(i)>0.) THEN               IF (zrfl(i)>0.) THEN
217                  IF (thermcep) THEN                  zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)
218                     zdelta = max(0., sign(1., rtt-zt(i)))                  zqs(i) = min(0.5, zqs(i))
219                     zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)                  zcor = 1./(1.-retv*zqs(i))
220                     zqs(i) = min(0.5, zqs(i))                  zqs(i) = zqs(i)*zcor
                    zcor = 1./(1.-retv*zqs(i))  
                    zqs(i) = zqs(i)*zcor  
                 ELSE  
                    IF (zt(i)<t_coup) THEN  
                       zqs(i) = qsats(zt(i))/pplay(i, k)  
                    ELSE  
                       zqs(i) = qsatl(zt(i))/pplay(i, k)  
                    END IF  
                 END IF  
221                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))
222                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &
223                       (paprs(i, k)-paprs(i, k+1))/pplay(i, k)*zt(i)*rd/rg                       (paprs(i, k)-paprs(i, k+1))/pplay(i, k)*zt(i)*rd/rg
# Line 245  contains Line 226  contains
226                  zqev = min(zqev, zqevt)                  zqev = min(zqev, zqevt)
227                  zrfln(i) = zrfl(i) - zqev*(paprs(i, k)-paprs(i, k+1))/rg/dtime                  zrfln(i) = zrfl(i) - zqev*(paprs(i, k)-paprs(i, k+1))/rg/dtime
228    
229                  ! pour la glace, on réévapore toute la précip dans la                  ! pour la glace, on r\'e\'evapore toute la pr\'ecip dans la
230                  ! couche du dessous la glace venant de la couche du                  ! couche du dessous la glace venant de la couche du
231                  ! dessus est simplement dans la couche du dessous.                  ! dessus est simplement dans la couche du dessous.
232    
# Line 262  contains Line 243  contains
243    
244         ! Calculer Qs et L/Cp*dQs/dT:         ! Calculer Qs et L/Cp*dQs/dT:
245    
246         IF (thermcep) THEN         DO i = 1, klon
247            DO i = 1, klon            zdelta = rtt >= zt(i)
248               zdelta = max(0., sign(1., rtt-zt(i)))            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
249               zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta            zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))
250               zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))            zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
251               zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)            zqs(i) = min(0.5, zqs(i))
252               zqs(i) = min(0.5, zqs(i))            zcor = 1./(1.-retv*zqs(i))
253               zcor = 1./(1.-retv*zqs(i))            zqs(i) = zqs(i)*zcor
254               zqs(i) = zqs(i)*zcor            zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)
255               zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)         END DO
           END DO  
        ELSE  
           DO i = 1, klon  
              IF (zt(i)<t_coup) THEN  
                 zqs(i) = qsats(zt(i))/pplay(i, k)  
                 zdqs(i) = dqsats(zt(i), zqs(i))  
              ELSE  
                 zqs(i) = qsatl(zt(i))/pplay(i, k)  
                 zdqs(i) = dqsatl(zt(i), zqs(i))  
              END IF  
           END DO  
        END IF  
256    
257         ! Determiner la condensation partielle et calculer la quantite         ! Determiner la condensation partielle et calculer la quantite
258         ! de l'eau condensee:         ! de l'eau condensee:
# Line 295  contains Line 264  contains
264            ! zqn : eau totale dans le nuage            ! zqn : eau totale dans le nuage
265            ! zcond : eau condensee moyenne dans la maille.            ! zcond : eau condensee moyenne dans la maille.
266    
267            ! on prend en compte le réchauffement qui diminue            ! on prend en compte le r\'echauffement qui diminue
268            ! la partie condensée            ! la partie condens\'ee
269    
270            ! Version avec les ratqs            ! Version avec les ratqs
271    
# Line 339  contains Line 308  contains
308               IF (rneb(i, k)<=0.0) zqn(i) = 0.0               IF (rneb(i, k)<=0.0) zqn(i) = 0.0
309               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)
310               rneb(i, k) = max(0., min(1., rneb(i, k)))               rneb(i, k) = max(0., min(1., rneb(i, k)))
311               ! 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
312               ! prédite par la convection. Attention : il va falloir               ! pr\'edite par la convection. Attention : il va falloir
313               ! verifier tout ca.               ! verifier tout ca.
314               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)
315               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 359  contains
359                     zcl(i) = cld_lc_lsc                     zcl(i) = cld_lc_lsc
360                     zct(i) = 1./cld_tau_lsc                     zct(i) = 1./cld_tau_lsc
361                  END IF                  END IF
362                  ! quantité d'eau à élminier.                  ! quantit\'e d'eau \`a \'eliminer
363                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &
364                       (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i))                       (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i))
365                  ! meme chose pour la glace.                  ! m\^eme chose pour la glace
366                  IF (ptconv(i, k)) THEN                  IF (ptconv(i, k)) THEN
367                     zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* &                     zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* &
368                          fallvc(zrhol(i))*zfice(i)                          fallvc(zrhol(i))*zfice(i)
# Line 423  contains Line 392  contains
392            END IF            END IF
393         END DO         END DO
394    
395         ! Calculer les tendances de q et de t:         ! Calculer les tendances de q et de t :
396         DO i = 1, klon         DO i = 1, klon
397            d_q(i, k) = zq(i) - q(i, k)            d_q(i, k) = zq(i) - q(i, k)
398            d_t(i, k) = zt(i) - t(i, k)            d_t(i, k) = zt(i) - t(i, k)
# Line 431  contains Line 400  contains
400    
401         ! Calcul du lessivage stratiforme         ! Calcul du lessivage stratiforme
402         DO i = 1, klon         DO i = 1, klon
403            zprec_cond(i) = max(zcond(i)-zoliq(i), 0.0)* &            zprec_cond(i) = max(zcond(i) - zoliq(i), 0.0) &
404                 (paprs(i, k)-paprs(i, k+1))/rg                 * (paprs(i, k)-paprs(i, k+1))/rg
405            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN            IF (rneb(i, k)>0.0 .AND. zprec_cond(i)>0.) THEN
406               ! lessivage nucleation LMD5 dans la couche elle-meme               ! lessivage nucleation LMD5 dans la couche elle-meme
407               IF (t(i, k)>=ztglace) THEN               IF (t(i, k)>=ztglace) THEN
# Line 491  contains Line 460  contains
460         END DO         END DO
461      END DO      END DO
462    
463      contains
464    
465        ! vitesse de chute pour cristaux de glace
466    
467        REAL function fallvs(zzz)
468          REAL, intent(in):: zzz
469          fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
470        end function fallvs
471    
472        !********************************************************
473    
474        real function fallvc(zzz)
475          REAL, intent(in):: zzz
476          fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
477        end function fallvc
478    
479    END SUBROUTINE fisrtilp    END SUBROUTINE fisrtilp
480    
481  end module fisrtilp_m  end module fisrtilp_m
Legend:
Removed from v.78  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21