/[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/phylmd/fisrtilp.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/fisrtilp.f revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 12  contains Line 12  contains
12      ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995      ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995
13      ! Other authors: Olivier, AA, IM, YM, MAF      ! Other authors: Olivier, AA, IM, YM, MAF
14    
15      ! Objet : condensation et précipitation stratiforme, schéma de      ! Objet : condensation et pr\'ecipitation stratiforme, sch\'ema de
16      ! nuage, schéma de condensation à grande échelle (pluie).      ! nuage, sch\'ema de condensation \`a grande \'echelle (pluie).
17    
18      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &      USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, &
19           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
20      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
21      USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats
22      USE numer_rec_95, ONLY: nr_erf      USE numer_rec_95, ONLY: nr_erf
23      USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt      USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt
24      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
# Line 87  contains Line 87  contains
87      PARAMETER (t_coup=234.0)      PARAMETER (t_coup=234.0)
88    
89      INTEGER i, k, n, kk      INTEGER i, k, n, kk
90      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5      REAL zqs(klon), zdqs(klon), zcor, zcvm5
91        logical zdelta
92      REAL zrfl(klon), zrfln(klon), zqev, zqevt      REAL zrfl(klon), zrfln(klon), zqev, zqevt
93      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
94      REAL ztglace, zt(klon)      REAL ztglace, zt(klon)
# Line 112  contains Line 113  contains
113      ! Pour la conversion eau-neige      ! Pour la conversion eau-neige
114      REAL zlh_solid(klon), zm_solid      REAL zlh_solid(klon), zm_solid
115    
     ! 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  
   
116      !---------------------------------------------------------------      !---------------------------------------------------------------
117    
118      zdelq = 0.0      zdelq = 0.0
# Line 129  contains Line 122  contains
122         PRINT *, 'fisrtilp, evap_prec:', evap_prec         PRINT *, 'fisrtilp, evap_prec:', evap_prec
123         PRINT *, 'fisrtilp, cpartiel:', cpartiel         PRINT *, 'fisrtilp, cpartiel:', cpartiel
124         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN         IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN
125            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
126            PRINT *, 'Je préfère un sous-intervalle de 6 minutes.'            PRINT *, "Je pr\'ef\`ere un sous-intervalle de 6 minutes."
127         END IF         END IF
128         appel1er = .FALSE.         appel1er = .FALSE.
129    
# Line 224  contains Line 217  contains
217            ! Calculer l'evaporation de la precipitation            ! Calculer l'evaporation de la precipitation
218            DO i = 1, klon            DO i = 1, klon
219               IF (zrfl(i)>0.) THEN               IF (zrfl(i)>0.) THEN
220                  IF (thermcep) THEN                  zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)
221                     zdelta = max(0., sign(1., rtt-zt(i)))                  zqs(i) = min(0.5, zqs(i))
222                     zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)                  zcor = 1./(1.-retv*zqs(i))
223                     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  
224                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))                  zqev = max(0.0, (zqs(i)-zq(i))*zneb(i))
225                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &                  zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* &
226                       (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 229  contains
229                  zqev = min(zqev, zqevt)                  zqev = min(zqev, zqevt)
230                  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
231    
232                  ! 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
233                  ! couche du dessous la glace venant de la couche du                  ! couche du dessous la glace venant de la couche du
234                  ! dessus est simplement dans la couche du dessous.                  ! dessus est simplement dans la couche du dessous.
235    
# Line 262  contains Line 246  contains
246    
247         ! Calculer Qs et L/Cp*dQs/dT:         ! Calculer Qs et L/Cp*dQs/dT:
248    
249         IF (thermcep) THEN         DO i = 1, klon
250            DO i = 1, klon            zdelta = rtt >= zt(i)
251               zdelta = max(0., sign(1., rtt-zt(i)))            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
252               zcvm5 = r5les*rlvtt*(1.-zdelta) + r5ies*rlstt*zdelta            zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))
253               zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i))            zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)
254               zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k)            zqs(i) = min(0.5, zqs(i))
255               zqs(i) = min(0.5, zqs(i))            zcor = 1./(1.-retv*zqs(i))
256               zcor = 1./(1.-retv*zqs(i))            zqs(i) = zqs(i)*zcor
257               zqs(i) = zqs(i)*zcor            zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor)
258               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  
259    
260         ! Determiner la condensation partielle et calculer la quantite         ! Determiner la condensation partielle et calculer la quantite
261         ! de l'eau condensee:         ! de l'eau condensee:
# Line 295  contains Line 267  contains
267            ! zqn : eau totale dans le nuage            ! zqn : eau totale dans le nuage
268            ! zcond : eau condensee moyenne dans la maille.            ! zcond : eau condensee moyenne dans la maille.
269    
270            ! on prend en compte le réchauffement qui diminue            ! on prend en compte le r\'echauffement qui diminue
271            ! la partie condensée            ! la partie condens\'ee
272    
273            ! Version avec les ratqs            ! Version avec les ratqs
274    
# Line 339  contains Line 311  contains
311               IF (rneb(i, k)<=0.0) zqn(i) = 0.0               IF (rneb(i, k)<=0.0) zqn(i) = 0.0
312               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)               IF (rneb(i, k)>=1.0) zqn(i) = zq(i)
313               rneb(i, k) = max(0., min(1., rneb(i, k)))               rneb(i, k) = max(0., min(1., rneb(i, k)))
314               ! 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
315               ! prédite par la convection. Attention : il va falloir               ! pr\'edite par la convection. Attention : il va falloir
316               ! verifier tout ca.               ! verifier tout ca.
317               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)               zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k)
318               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 362  contains
362                     zcl(i) = cld_lc_lsc                     zcl(i) = cld_lc_lsc
363                     zct(i) = 1./cld_tau_lsc                     zct(i) = 1./cld_tau_lsc
364                  END IF                  END IF
365                  ! quantité d'eau à élminier.                  ! quantit\'e d'eau \`a \'elminier.
366                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &                  zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* &
367                       (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))
368                  ! meme chose pour la glace.                  ! meme chose pour la glace.
# Line 491  contains Line 463  contains
463         END DO         END DO
464      END DO      END DO
465    
466      contains
467    
468        ! vitesse de chute pour cristaux de glace
469    
470        REAL function fallvs(zzz)
471          REAL, intent(in):: zzz
472          fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
473        end function fallvs
474    
475        !********************************************************
476    
477        real function fallvc(zzz)
478          REAL, intent(in):: zzz
479          fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
480        end function fallvc
481    
482    END SUBROUTINE fisrtilp    END SUBROUTINE fisrtilp
483    
484  end module fisrtilp_m  end module fisrtilp_m
Legend:
Removed from v.82  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21