| 1 | |
|---|
| 2 | ! $Header$ |
|---|
| 3 | |
|---|
| 4 | SUBROUTINE tlift43(p, t, q, qs, gz, icb, nk, tvp, tpk, clw, nd, nl, kk) |
|---|
| 5 | USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO & |
|---|
| 6 | , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA & |
|---|
| 7 | , R_ecc, R_peri, R_incl & |
|---|
| 8 | , RA, RG, R1SA & |
|---|
| 9 | , RSIGMA & |
|---|
| 10 | , R, RMD, RMV, RD, RV, RCPD & |
|---|
| 11 | , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 & |
|---|
| 12 | , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w & |
|---|
| 13 | , RCW, RCS & |
|---|
| 14 | , RLVTT, RLSTT, RLMLT, RTT, RATM & |
|---|
| 15 | , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS & |
|---|
| 16 | , RALPD, RBETD, RGAMD |
|---|
| 17 | IMPLICIT NONE |
|---|
| 18 | REAL gz(nd), tpk(nd), clw(nd), p(nd) |
|---|
| 19 | REAL t(nd), q(nd), qs(nd), tvp(nd), lv0 |
|---|
| 20 | INTEGER icb, nk, nd, nl, kk |
|---|
| 21 | REAL cpd, cpv, cl, g, rowl, gravity, cpvmcl, eps, epsi |
|---|
| 22 | REAL ah0, cpp, cpinv, tg, qg, alv, s, ahg, tc, denom, es |
|---|
| 23 | INTEGER i, nst, nsb, j |
|---|
| 24 | ! *** ASSIGN VALUES OF THERMODYNAMIC CONSTANTS *** |
|---|
| 25 | |
|---|
| 26 | ! -- sb: |
|---|
| 27 | ! ! CPD=1005.7 |
|---|
| 28 | ! ! CPV=1870.0 |
|---|
| 29 | ! ! CL=4190.0 |
|---|
| 30 | ! ! RV=461.5 |
|---|
| 31 | ! ! RD=287.04 |
|---|
| 32 | ! ! LV0=2.501E6 |
|---|
| 33 | ! ! G=9.8 |
|---|
| 34 | ! ! ROWL=1000.0 |
|---|
| 35 | ! ajouts: |
|---|
| 36 | cpd = rcpd |
|---|
| 37 | cpv = rcpv |
|---|
| 38 | cl = rcw |
|---|
| 39 | lv0 = rlvtt |
|---|
| 40 | g = rg |
|---|
| 41 | rowl = ratm/100. |
|---|
| 42 | gravity = rg !sb: Pr que gravite ne devienne pas humidite! |
|---|
| 43 | ! sb -- |
|---|
| 44 | |
|---|
| 45 | cpvmcl = cl - cpv |
|---|
| 46 | eps = rd/rv |
|---|
| 47 | epsi = 1./eps |
|---|
| 48 | |
|---|
| 49 | ! *** CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY *** |
|---|
| 50 | |
|---|
| 51 | ah0 = (cpd*(1.-q(nk))+cl*q(nk))*t(nk) + q(nk)*(lv0-cpvmcl*(t(nk)-273.15)) + & |
|---|
| 52 | gz(nk) |
|---|
| 53 | cpp = cpd*(1.-q(nk)) + q(nk)*cpv |
|---|
| 54 | cpinv = 1./cpp |
|---|
| 55 | |
|---|
| 56 | IF (kk==1) THEN |
|---|
| 57 | |
|---|
| 58 | ! *** CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE *** |
|---|
| 59 | |
|---|
| 60 | DO i = 1, icb - 1 |
|---|
| 61 | clw(i) = 0.0 |
|---|
| 62 | END DO |
|---|
| 63 | DO i = nk, icb - 1 |
|---|
| 64 | tpk(i) = t(nk) - (gz(i)-gz(nk))*cpinv |
|---|
| 65 | tvp(i) = tpk(i)*(1.+q(nk)*epsi) |
|---|
| 66 | END DO |
|---|
| 67 | END IF |
|---|
| 68 | |
|---|
| 69 | ! *** FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE *** |
|---|
| 70 | |
|---|
| 71 | nst = icb |
|---|
| 72 | nsb = icb |
|---|
| 73 | IF (kk==2) THEN |
|---|
| 74 | nst = nl |
|---|
| 75 | nsb = icb + 1 |
|---|
| 76 | END IF |
|---|
| 77 | DO i = nsb, nst |
|---|
| 78 | tg = t(i) |
|---|
| 79 | qg = qs(i) |
|---|
| 80 | alv = lv0 - cpvmcl*(t(i)-273.15) |
|---|
| 81 | DO j = 1, 2 |
|---|
| 82 | s = cpd + alv*alv*qg/(rv*t(i)*t(i)) |
|---|
| 83 | s = 1./s |
|---|
| 84 | ahg = cpd*tg + (cl-cpd)*q(nk)*t(i) + alv*qg + gz(i) |
|---|
| 85 | tg = tg + s*(ah0-ahg) |
|---|
| 86 | tg = max(tg, 35.0) |
|---|
| 87 | tc = tg - 273.15 |
|---|
| 88 | denom = 243.5 + tc |
|---|
| 89 | IF (tc>=0.0) THEN |
|---|
| 90 | es = 6.112*exp(17.67*tc/denom) |
|---|
| 91 | ELSE |
|---|
| 92 | es = exp(23.33086-6111.72784/tg+0.15215*log(tg)) |
|---|
| 93 | END IF |
|---|
| 94 | qg = eps*es/(p(i)-es*(1.-eps)) |
|---|
| 95 | END DO |
|---|
| 96 | alv = lv0 - cpvmcl*(t(i)-273.15) |
|---|
| 97 | tpk(i) = (ah0-(cl-cpd)*q(nk)*t(i)-gz(i)-alv*qg)/cpd |
|---|
| 98 | clw(i) = q(nk) - qg |
|---|
| 99 | clw(i) = max(0.0, clw(i)) |
|---|
| 100 | rg = qg/(1.-q(nk)) |
|---|
| 101 | tvp(i) = tpk(i)*(1.+rg*epsi) |
|---|
| 102 | END DO |
|---|
| 103 | |
|---|
| 104 | ! -- sb: |
|---|
| 105 | rg = gravity ! RG redevient la gravite de YOMCST (sb) |
|---|
| 106 | ! sb -- |
|---|
| 107 | |
|---|
| 108 | RETURN |
|---|
| 109 | END SUBROUTINE tlift43 |
|---|
| 110 | |
|---|
