| 1 | |
|---|
| 2 | ! $Header$ |
|---|
| 3 | |
|---|
| 4 | SUBROUTINE tlift43(p, t, q, qs, gz, icb, nk, tvp, tpk, clw, nd, nl, kk) |
|---|
| 5 | IMPLICIT NONE |
|---|
| 6 | REAL gz(nd), tpk(nd), clw(nd), p(nd) |
|---|
| 7 | REAL t(nd), q(nd), qs(nd), tvp(nd), lv0 |
|---|
| 8 | INTEGER icb, nk, nd, nl, kk |
|---|
| 9 | REAL cpd, cpv, cl, g, rowl, gravity, cpvmcl, eps, epsi |
|---|
| 10 | REAL ah0, cpp, cpinv, tg, qg, alv, s, ahg, tc, denom, es |
|---|
| 11 | INTEGER i, nst, nsb, j |
|---|
| 12 | ! *** ASSIGN VALUES OF THERMODYNAMIC CONSTANTS *** |
|---|
| 13 | |
|---|
| 14 | ! -- sb: |
|---|
| 15 | ! ! CPD=1005.7 |
|---|
| 16 | ! ! CPV=1870.0 |
|---|
| 17 | ! ! CL=4190.0 |
|---|
| 18 | ! ! RV=461.5 |
|---|
| 19 | ! ! RD=287.04 |
|---|
| 20 | ! ! LV0=2.501E6 |
|---|
| 21 | ! ! G=9.8 |
|---|
| 22 | ! ! ROWL=1000.0 |
|---|
| 23 | ! ajouts: |
|---|
| 24 | include "YOMCST.h" |
|---|
| 25 | cpd = rcpd |
|---|
| 26 | cpv = rcpv |
|---|
| 27 | cl = rcw |
|---|
| 28 | lv0 = rlvtt |
|---|
| 29 | g = rg |
|---|
| 30 | rowl = ratm/100. |
|---|
| 31 | gravity = rg !sb: Pr que gravite ne devienne pas humidite! |
|---|
| 32 | ! sb -- |
|---|
| 33 | |
|---|
| 34 | cpvmcl = cl - cpv |
|---|
| 35 | eps = rd/rv |
|---|
| 36 | epsi = 1./eps |
|---|
| 37 | |
|---|
| 38 | ! *** CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY *** |
|---|
| 39 | |
|---|
| 40 | ah0 = (cpd*(1.-q(nk))+cl*q(nk))*t(nk) + q(nk)*(lv0-cpvmcl*(t(nk)-273.15)) + & |
|---|
| 41 | gz(nk) |
|---|
| 42 | cpp = cpd*(1.-q(nk)) + q(nk)*cpv |
|---|
| 43 | cpinv = 1./cpp |
|---|
| 44 | |
|---|
| 45 | IF (kk==1) THEN |
|---|
| 46 | |
|---|
| 47 | ! *** CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE *** |
|---|
| 48 | |
|---|
| 49 | DO i = 1, icb - 1 |
|---|
| 50 | clw(i) = 0.0 |
|---|
| 51 | END DO |
|---|
| 52 | DO i = nk, icb - 1 |
|---|
| 53 | tpk(i) = t(nk) - (gz(i)-gz(nk))*cpinv |
|---|
| 54 | tvp(i) = tpk(i)*(1.+q(nk)*epsi) |
|---|
| 55 | END DO |
|---|
| 56 | END IF |
|---|
| 57 | |
|---|
| 58 | ! *** FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE *** |
|---|
| 59 | |
|---|
| 60 | nst = icb |
|---|
| 61 | nsb = icb |
|---|
| 62 | IF (kk==2) THEN |
|---|
| 63 | nst = nl |
|---|
| 64 | nsb = icb + 1 |
|---|
| 65 | END IF |
|---|
| 66 | DO i = nsb, nst |
|---|
| 67 | tg = t(i) |
|---|
| 68 | qg = qs(i) |
|---|
| 69 | alv = lv0 - cpvmcl*(t(i)-273.15) |
|---|
| 70 | DO j = 1, 2 |
|---|
| 71 | s = cpd + alv*alv*qg/(rv*t(i)*t(i)) |
|---|
| 72 | s = 1./s |
|---|
| 73 | ahg = cpd*tg + (cl-cpd)*q(nk)*t(i) + alv*qg + gz(i) |
|---|
| 74 | tg = tg + s*(ah0-ahg) |
|---|
| 75 | tg = max(tg, 35.0) |
|---|
| 76 | tc = tg - 273.15 |
|---|
| 77 | denom = 243.5 + tc |
|---|
| 78 | IF (tc>=0.0) THEN |
|---|
| 79 | es = 6.112*exp(17.67*tc/denom) |
|---|
| 80 | ELSE |
|---|
| 81 | es = exp(23.33086-6111.72784/tg+0.15215*log(tg)) |
|---|
| 82 | END IF |
|---|
| 83 | qg = eps*es/(p(i)-es*(1.-eps)) |
|---|
| 84 | END DO |
|---|
| 85 | alv = lv0 - cpvmcl*(t(i)-273.15) |
|---|
| 86 | tpk(i) = (ah0-(cl-cpd)*q(nk)*t(i)-gz(i)-alv*qg)/cpd |
|---|
| 87 | clw(i) = q(nk) - qg |
|---|
| 88 | clw(i) = max(0.0, clw(i)) |
|---|
| 89 | rg = qg/(1.-q(nk)) |
|---|
| 90 | tvp(i) = tpk(i)*(1.+rg*epsi) |
|---|
| 91 | END DO |
|---|
| 92 | |
|---|
| 93 | ! -- sb: |
|---|
| 94 | rg = gravity ! RG redevient la gravite de YOMCST (sb) |
|---|
| 95 | ! sb -- |
|---|
| 96 | |
|---|
| 97 | RETURN |
|---|
| 98 | END SUBROUTINE tlift43 |
|---|
| 99 | |
|---|
