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