Changeset 1992 for LMDZ5/trunk/libf/phylmd/tilft43.F90
- Timestamp:
- Mar 5, 2014, 2:19:12 PM (11 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/tilft43.F90
r1988 r1992 1 ! 1 2 2 ! $Header$ 3 !4 SUBROUTINE TLIFT43(P,T,Q,QS,GZ,ICB,NK,TVP,TPK,CLW,ND,NL,KK)5 REAL GZ(ND),TPK(ND),CLW(ND),P(ND)6 REAL T(ND),Q(ND),QS(ND),TVP(ND),LV07 C8 C *** ASSIGN VALUES OF THERMODYNAMIC CONSTANTS ***9 C10 c -- sb:11 c! CPD=1005.712 c! CPV=1870.013 c! CL=4190.014 c! RV=461.515 c! RD=287.0416 c! LV0=2.501E617 c! G=9.818 c! ROWL=1000.019 c ajouts:20 #include "YOMCST.h"21 CPD = RCPD22 CPV = RCPV23 CL = RCW24 LV0 = RLVTT25 G = RG26 ROWL= RATM/100.27 GRAVITY = RG !sb: Pr que gravite ne devienne pas humidite!28 C sb --29 C30 CPVMCL=CL-CPV31 EPS=RD/RV32 EPSI=1./EPS33 C34 C *** CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY ***35 C36 AH0=(CPD*(1.-Q(NK))+CL*Q(NK))*T(NK)+Q(NK)*(LV0-CPVMCL*(37 1 T(NK)-273.15))+GZ(NK)38 CPP=CPD*(1.-Q(NK))+Q(NK)*CPV39 CPINV=1./CPP40 C41 IF(KK.EQ.1)THEN42 C43 C *** CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE ***44 C45 DO 50 I=1,ICB-146 CLW(I)=0.047 50 CONTINUE48 DO 100 I=NK,ICB-149 TPK(I)=T(NK)-(GZ(I)-GZ(NK))*CPINV50 TVP(I)=TPK(I)*(1.+Q(NK)*EPSI)51 100 CONTINUE52 END IF53 C54 C *** FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE ***55 C56 NST=ICB57 NSB=ICB58 IF(KK.EQ.2)THEN59 NST=NL60 NSB=ICB+161 END IF62 DO 300 I=NSB,NST63 TG=T(I)64 QG=QS(I)65 ALV=LV0-CPVMCL*(T(I)-273.15)66 DO 200 J=1,267 S=CPD+ALV*ALV*QG/(RV*T(I)*T(I))68 S=1./S69 AHG=CPD*TG+(CL-CPD)*Q(NK)*T(I)+ALV*QG+GZ(I)70 TG=TG+S*(AH0-AHG)71 TG=MAX(TG,35.0)72 TC=TG-273.1573 DENOM=243.5+TC74 IF(TC.GE.0.0)THEN75 ES=6.112*EXP(17.67*TC/DENOM)76 ELSE77 ES=EXP(23.33086-6111.72784/TG+0.15215*LOG(TG))78 END IF79 QG=EPS*ES/(P(I)-ES*(1.-EPS))80 200 CONTINUE81 ALV=LV0-CPVMCL*(T(I)-273.15)82 TPK(I)=(AH0-(CL-CPD)*Q(NK)*T(I)-GZ(I)-ALV*QG)/CPD83 CLW(I)=Q(NK)-QG84 CLW(I)=MAX(0.0,CLW(I))85 RG=QG/(1.-Q(NK))86 TVP(I)=TPK(I)*(1.+RG*EPSI)87 300 CONTINUE88 3 89 c -- sb: 90 RG = GRAVITY ! RG redevient la gravite de YOMCST (sb)91 c sb -- 4 SUBROUTINE tlift43(p, t, q, qs, gz, icb, nk, tvp, tpk, clw, nd, nl, kk) 5 REAL gz(nd), tpk(nd), clw(nd), p(nd) 6 REAL t(nd), q(nd), qs(nd), tvp(nd), lv0 92 7 93 RETURN 94 END 8 ! *** ASSIGN VALUES OF THERMODYNAMIC CONSTANTS *** 95 9 10 ! -- sb: 11 ! ! CPD=1005.7 12 ! ! CPV=1870.0 13 ! ! CL=4190.0 14 ! ! RV=461.5 15 ! ! RD=287.04 16 ! ! LV0=2.501E6 17 ! ! G=9.8 18 ! ! ROWL=1000.0 19 ! ajouts: 20 include "YOMCST.h" 21 cpd = rcpd 22 cpv = rcpv 23 cl = rcw 24 lv0 = rlvtt 25 g = rg 26 rowl = ratm/100. 27 gravity = rg !sb: Pr que gravite ne devienne pas humidite! 28 ! sb -- 29 30 cpvmcl = cl - cpv 31 eps = rd/rv 32 epsi = 1./eps 33 34 ! *** CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY *** 35 36 ah0 = (cpd*(1.-q(nk))+cl*q(nk))*t(nk) + q(nk)*(lv0-cpvmcl*(t(nk)-273.15)) + & 37 gz(nk) 38 cpp = cpd*(1.-q(nk)) + q(nk)*cpv 39 cpinv = 1./cpp 40 41 IF (kk==1) THEN 42 43 ! *** CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE *** 44 45 DO i = 1, icb - 1 46 clw(i) = 0.0 47 END DO 48 DO i = nk, icb - 1 49 tpk(i) = t(nk) - (gz(i)-gz(nk))*cpinv 50 tvp(i) = tpk(i)*(1.+q(nk)*epsi) 51 END DO 52 END IF 53 54 ! *** FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE *** 55 56 nst = icb 57 nsb = icb 58 IF (kk==2) THEN 59 nst = nl 60 nsb = icb + 1 61 END IF 62 DO i = nsb, nst 63 tg = t(i) 64 qg = qs(i) 65 alv = lv0 - cpvmcl*(t(i)-273.15) 66 DO j = 1, 2 67 s = cpd + alv*alv*qg/(rv*t(i)*t(i)) 68 s = 1./s 69 ahg = cpd*tg + (cl-cpd)*q(nk)*t(i) + alv*qg + gz(i) 70 tg = tg + s*(ah0-ahg) 71 tg = max(tg, 35.0) 72 tc = tg - 273.15 73 denom = 243.5 + tc 74 IF (tc>=0.0) THEN 75 es = 6.112*exp(17.67*tc/denom) 76 ELSE 77 es = exp(23.33086-6111.72784/tg+0.15215*log(tg)) 78 END IF 79 qg = eps*es/(p(i)-es*(1.-eps)) 80 END DO 81 alv = lv0 - cpvmcl*(t(i)-273.15) 82 tpk(i) = (ah0-(cl-cpd)*q(nk)*t(i)-gz(i)-alv*qg)/cpd 83 clw(i) = q(nk) - qg 84 clw(i) = max(0.0, clw(i)) 85 rg = qg/(1.-q(nk)) 86 tvp(i) = tpk(i)*(1.+rg*epsi) 87 END DO 88 89 ! -- sb: 90 rg = gravity ! RG redevient la gravite de YOMCST (sb) 91 ! sb -- 92 93 RETURN 94 END SUBROUTINE tlift43 95
Note: See TracChangeset
for help on using the changeset viewer.