--- trunk/Sources/phylmd/fisrtilp.f 2015/04/29 15:47:56 134 +++ trunk/phylmd/fisrtilp.f90 2019/09/26 17:08:42 339 @@ -4,28 +4,26 @@ contains - SUBROUTINE fisrtilp(dtime, paprs, pplay, t, q, ptconv, ratqs, d_t, d_q, & - d_ql, rneb, radliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, & - frac_impa, frac_nucl, prfl, psfl, rhcl) + SUBROUTINE fisrtilp(paprs, pplay, t, q, ptconv, ratqs, d_t, d_q, d_ql, rneb, & + cldliq, rain, snow, pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, & + frac_nucl, prfl, psfl, rhcl) - ! 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 ! First author: Z. X. Li (LMD/CNRS), 20 mars 1995 - ! Other authors: Olivier, AA, IM, YM, MAF - ! Objet : condensation et précipitation stratiforme, schéma de - ! nuage, schéma de condensation à grande échelle (pluie). + ! Objet : condensation et pr\'ecipitation stratiforme, sch\'ema de + ! nuage, sch\'ema de condensation \`a grande \'echelle (pluie). + USE numer_rec_95, ONLY: nr_erf + + use comconst, only: dtphys USE comfisrtilp, ONLY: cld_lc_con, cld_lc_lsc, cld_tau_con, & cld_tau_lsc, coef_eva, ffallv_con, ffallv_lsc, iflag_pdf, reevap_ice USE dimphy, ONLY: klev, klon - USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep - USE numer_rec_95, ONLY: nr_erf + USE fcttre, ONLY: foede, foeew USE suphec_m, ONLY: rcpd, rd, retv, rg, rlstt, rlvtt, rtt USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2 - ! Arguments: - - REAL, INTENT (IN):: dtime ! intervalle du temps (s) REAL, INTENT (IN):: paprs(klon, klev+1) ! pression a inter-couche REAL, INTENT (IN):: pplay(klon, klev) ! pression au milieu de couche REAL, INTENT (IN):: t(klon, klev) ! temperature (K) @@ -40,7 +38,7 @@ REAL, INTENT (out):: d_ql(klon, klev) ! incrementation de l'eau liquide REAL, INTENT (out):: rneb(klon, klev) ! fraction nuageuse - REAL, INTENT (out):: radliq(klon, klev) + REAL, INTENT (out):: cldliq(klon, klev) ! eau liquide utilisee dans rayonnement REAL, INTENT (out):: rain(klon) ! pluies (mm/s) @@ -121,9 +119,9 @@ PRINT *, 'fisrtilp, ninter:', ninter PRINT *, 'fisrtilp, evap_prec:', evap_prec PRINT *, 'fisrtilp, cpartiel:', cpartiel - IF (abs(dtime / real(ninter) - 360.) > 0.001) THEN - PRINT *, "fisrtilp : ce n'est pas prévu, voir Z. X. Li", dtime - PRINT *, 'Je préfère un sous-intervalle de 6 minutes.' + IF (abs(dtphys / real(ninter) - 360.) > 0.001) THEN + PRINT *, "fisrtilp : ce n'est pas pr\'evu, voir Z. X. Li", dtphys + PRINT *, "Je pr\'ef\`ere un sous-intervalle de 6 minutes." END IF appel1er = .FALSE. @@ -168,7 +166,7 @@ d_q(i, k) = 0.0 d_ql(i, k) = 0.0 rneb(i, k) = 0.0 - radliq(i, k) = 0.0 + cldliq(i, k) = 0.0 frac_nucl(i, k) = 1. frac_impa(i, k) = 1. END DO @@ -207,9 +205,9 @@ zmair = (paprs(i, k)-paprs(i, k+1))/rg zcpair = rcpd*(1.0+rvtmp2*zq(i)) zcpeau = rcpd*rvtmp2 - 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 & * zcpeau + zmair * zcpair* zt(i)) & - / (zmair * zcpair + zrfl(i) * dtime * zcpeau) + / (zmair * zcpair + zrfl(i) * dtphys * zcpeau) END IF END DO @@ -217,36 +215,28 @@ ! Calculer l'evaporation de la precipitation DO i = 1, klon IF (zrfl(i)>0.) THEN - IF (thermcep) THEN - zqs(i) = r2es*foeew(zt(i), rtt >= zt(i))/pplay(i, k) - zqs(i) = min(0.5, zqs(i)) - zcor = 1./(1.-retv*zqs(i)) - zqs(i) = zqs(i)*zcor - ELSE - IF (zt(i)= zt(i))/pplay(i, k) + zqs(i) = min(0.5, zqs(i)) + zcor = 1./(1.-retv*zqs(i)) + zqs(i) = zqs(i)*zcor zqev = max(0.0, (zqs(i)-zq(i))*zneb(i)) zqevt = coef_eva*(1.0-zq(i)/zqs(i))*sqrt(zrfl(i))* & (paprs(i, k)-paprs(i, k+1))/pplay(i, k)*zt(i)*rd/rg - zqevt = max(0.0, min(zqevt, zrfl(i)))*rg*dtime/ & + zqevt = max(0.0, min(zqevt, zrfl(i)))*rg*dtphys/ & (paprs(i, k)-paprs(i, k+1)) zqev = min(zqev, zqevt) - 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 - ! 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 ! couche du dessous la glace venant de la couche du ! dessus est simplement dans la couche du dessous. IF (zt(i)= zt(i) - zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta) - zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i)) - zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k) - zqs(i) = min(0.5, zqs(i)) - zcor = 1./(1.-retv*zqs(i)) - zqs(i) = zqs(i)*zcor - zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor) - END DO - ELSE - DO i = 1, klon - IF (zt(i)= zt(i) + zcvm5 = merge(r5ies*rlstt, r5les*rlvtt, zdelta) + zcvm5 = zcvm5/rcpd/(1.0+rvtmp2*zq(i)) + zqs(i) = r2es*foeew(zt(i), zdelta)/pplay(i, k) + zqs(i) = min(0.5, zqs(i)) + zcor = 1./(1.-retv*zqs(i)) + zqs(i) = zqs(i)*zcor + zdqs(i) = foede(zt(i), zdelta, zcvm5, zqs(i), zcor) + END DO ! Determiner la condensation partielle et calculer la quantite ! de l'eau condensee: @@ -287,8 +265,8 @@ ! zqn : eau totale dans le nuage ! zcond : eau condensee moyenne dans la maille. - ! on prend en compte le réchauffement qui diminue - ! la partie condensée + ! on prend en compte le r\'echauffement qui diminue + ! la partie condens\'ee ! Version avec les ratqs @@ -331,8 +309,8 @@ IF (rneb(i, k)<=0.0) zqn(i) = 0.0 IF (rneb(i, k)>=1.0) zqn(i) = zq(i) rneb(i, k) = max(0., min(1., rneb(i, k))) - ! On ne divise pas par 1 + zdqs pour forcer à avoir l'eau - ! prédite par la convection. Attention : il va falloir + ! On ne divise pas par 1 + zdqs pour forcer \`a avoir l'eau + ! pr\'edite par la convection. Attention : il va falloir ! verifier tout ca. zcond(i) = max(0., zqn(i)-zqs(i))*rneb(i, k) rhcl(i, k) = (zqs(i)+zq(i)-zdelq)/2./zqs(i) @@ -366,7 +344,7 @@ zfice(i) = min(max(zfice(i), 0.0), 1.0) zfice(i) = zfice(i)**nexpo zneb(i) = max(rneb(i, k), seuil_neb) - radliq(i, k) = zoliq(i)/real(ninter+1) + cldliq(i, k) = zoliq(i)/real(ninter+1) END IF END DO @@ -382,22 +360,22 @@ zcl(i) = cld_lc_lsc zct(i) = 1./cld_tau_lsc END IF - ! quantité d'eau à élminier. - zchau(i) = zct(i)*dtime/real(ninter)*zoliq(i)* & + ! quantit\'e d'eau \`a \'eliminer + zchau(i) = zct(i)*dtphys/real(ninter)*zoliq(i)* & (1.0-exp(-(zoliq(i)/zneb(i)/zcl(i))**2))*(1.-zfice(i)) - ! meme chose pour la glace. + ! m\^eme chose pour la glace IF (ptconv(i, k)) THEN - zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* & + zfroi(i) = dtphys/real(ninter)/zdz(i)*zoliq(i)* & fallvc(zrhol(i))*zfice(i) ELSE - zfroi(i) = dtime/real(ninter)/zdz(i)*zoliq(i)* & + zfroi(i) = dtphys/real(ninter)/zdz(i)*zoliq(i)* & fallvs(zrhol(i))*zfice(i) END IF ztot(i) = zchau(i) + zfroi(i) IF (zneb(i)==seuil_neb) ztot(i) = 0.0 ztot(i) = min(max(ztot(i), 0.0), zoliq(i)) zoliq(i) = max(zoliq(i)-ztot(i), 0.0) - radliq(i, k) = radliq(i, k) + zoliq(i)/real(ninter+1) + cldliq(i, k) = cldliq(i, k) + zoliq(i)/real(ninter+1) END IF END DO END DO @@ -406,7 +384,7 @@ IF (rneb(i, k)>0.0) THEN d_ql(i, k) = zoliq(i) zrfl(i) = zrfl(i) + max(zcond(i) - zoliq(i), 0.) & - * (paprs(i, k) - paprs(i, k + 1)) / (rg * dtime) + * (paprs(i, k) - paprs(i, k + 1)) / (rg * dtphys) END IF IF (zt(i)0.0 .AND. zprec_cond(i)>0.) THEN ! lessivage nucleation LMD5 dans la couche elle-meme IF (t(i, k)>=ztglace) THEN @@ -478,22 +456,24 @@ DO i = 1, klon zcpair = rcpd*(1.0+rvtmp2*(q(i, k)+d_q(i, k))) zmair = (paprs(i, k)-paprs(i, k+1))/rg - 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 d_t(i, k) = d_t(i, k) + zlh_solid(i)*zm_solid/(zcpair*zmair) END DO END DO contains - ! vitesse de chute pour crystaux de glace + ! vitesse de chute pour cristaux de glace REAL function fallvs(zzz) - REAL zzz + REAL, intent(in):: zzz fallvs = 3.29/2.0*((zzz)**0.16)*ffallv_lsc end function fallvs + !******************************************************** + real function fallvc(zzz) - REAL zzz + REAL, intent(in):: zzz fallvc = 3.29/2.0*((zzz)**0.16)*ffallv_con end function fallvc