/[lmdze]/trunk/Sources/phylmd/fisrtilp.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/fisrtilp.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 206 by guez, Wed Apr 29 15:47:56 2015 UTC 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 122  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 217  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                     zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k)                  zqs(i) = min(0.5, zqs(i))
222                     zqs(i) = min(0.5, zqs(i))                  zcor = 1./(1.-retv*zqs(i))
223                     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  
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 237  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 254  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 = rtt >= zt(i)            zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta)
252               zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, 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 287  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 331  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 382  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 485  contains Line 465  contains
465    
466    contains    contains
467    
468      ! vitesse de chute pour crystaux de glace      ! vitesse de chute pour cristaux de glace
469    
470      REAL function fallvs(zzz)      REAL function fallvs(zzz)
471        REAL zzz        REAL, intent(in):: zzz
472        fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc        fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc
473      end function fallvs      end function fallvs
474    
475        !********************************************************
476    
477      real function fallvc(zzz)      real function fallvc(zzz)
478        REAL zzz        REAL, intent(in):: zzz
479        fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con        fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con
480      end function fallvc      end function fallvc
481    
Legend:
Removed from v.206  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21