/[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.f revision 103 by guez, Fri Aug 29 13:00:05 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 113  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 130  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 225  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                     zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)                  zqs(i) = min(0.5, zqs(i))
219                     zqs(i) = min(0.5, zqs(i))                  zcor = 1./(1.-retv*zqs(i))
220                     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  
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 = rtt >= zt(i)            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
249               zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, 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.103  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21