1 |
module cv3_undilute2_m |
module cv30_undilute2_m |
2 |
|
|
3 |
implicit none |
implicit none |
4 |
|
|
5 |
contains |
contains |
6 |
|
|
7 |
SUBROUTINE cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, t, & |
SUBROUTINE cv30_undilute2(icb, icbs, tnk, qnk, gznk, t, qs, gz, p, h, tv, & |
8 |
qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, & |
lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, ep, buoy) |
9 |
ep, sigp, buoy) |
|
10 |
|
! Undilute (adiabatic) updraft, second part. Purpose: find the |
11 |
! Purpose: find the rest of the lifted parcel temperatures; |
! rest of the lifted parcel temperatures; compute the |
12 |
! compute the precipitation efficiencies and the fraction of |
! precipitation efficiencies and the fraction of precipitation |
13 |
! precipitation falling outside of cloud; find the level of |
! falling outside of cloud; find the level of neutral buoyancy. |
|
! neutral buoyancy. |
|
14 |
|
|
15 |
! Vertical profile of buoyancy computed here (use of buoybase). |
! Vertical profile of buoyancy computed here (use of buoybase). |
16 |
|
|
17 |
use conema3_m, only: epmax |
use conema3_m, only: epmax |
18 |
use cv3_param_m, only: dtovsh, minorig, nl, nlp, pbcrit, ptcrit, spfac |
use cv30_param_m, only: minorig, nl |
19 |
use cvthermo, only: cl, clmcpv, cpd, cpv, eps, lv0, rrv |
use cv_thermo_m, only: cl, clmcpv, cpd, cpv, eps, rrv |
20 |
|
USE dimphy, ONLY: klon, klev |
21 |
! inputs: |
use SUPHEC_M, only: rlvtt |
22 |
integer, intent(in):: nloc, ncum, nd |
|
23 |
integer icb(nloc), icbs(nloc), nk(nloc) |
integer, intent(in):: icb(:), icbs(:) ! (ncum) |
24 |
! icbs (input) is the first level above LCL (may differ from icb) |
! icbs is the first level above LCL (may differ from icb) |
25 |
real tnk(nloc), qnk(nloc), gznk(nloc) |
|
26 |
real t(nloc, nd), qs(nloc, nd), gz(nloc, nd) |
real, intent(in):: tnk(:), qnk(:), gznk(:) ! (klon) |
27 |
real p(nloc, nd), h(nloc, nd) |
real, intent(in):: t(klon, klev), qs(klon, klev), gz(klon, klev) |
28 |
real tv(nloc, nd), lv(nloc, nd) |
real, intent(in):: p(klon, klev), h(klon, klev) |
29 |
real pbase(nloc), buoybase(nloc), plcl(nloc) |
real, intent(in):: tv(klon, klev), lv(klon, klev) |
30 |
|
real, intent(in):: pbase(:), buoybase(:), plcl(:) ! (ncum) |
31 |
|
|
32 |
! outputs: |
! outputs: |
33 |
integer inb(nloc) |
integer, intent(out):: inb(:) ! (ncum) |
34 |
real tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd) |
! first model level above the level of neutral buoyancy of the |
35 |
|
! parcel (1 <= inb <= nl - 1) |
36 |
|
|
37 |
|
real tp(klon, klev), tvp(klon, klev), clw(klon, klev) |
38 |
! condensed water not removed from tvp |
! condensed water not removed from tvp |
39 |
real hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd) |
real hp(klon, klev), ep(klon, klev) |
40 |
real buoy(nloc, nd) |
real buoy(klon, klev) |
41 |
|
|
42 |
! Local: |
! Local: |
43 |
|
|
44 |
|
integer ncum |
45 |
|
|
46 |
|
real, parameter:: pbcrit = 150. |
47 |
|
! critical cloud depth (mbar) beneath which the precipitation |
48 |
|
! efficiency is assumed to be zero |
49 |
|
|
50 |
|
real, parameter:: ptcrit = 500. |
51 |
|
! cloud depth (mbar) above which the precipitation efficiency is |
52 |
|
! assumed to be unity |
53 |
|
|
54 |
|
real, parameter:: dtovsh = - 0.2 ! dT for overshoot |
55 |
|
|
56 |
integer i, k |
integer i, k |
57 |
real tg, qg, ahg, alv, s, tc, es, denom |
real tg, qg, ahg, alv, s, tc, es, denom |
58 |
real pden |
real pden |
59 |
real ah0(nloc) |
real ah0(klon) |
60 |
|
|
61 |
!--------------------------------------------------------------------- |
!--------------------------------------------------------------------- |
62 |
|
|
63 |
|
ncum = size(icb) |
64 |
|
|
65 |
! SOME INITIALIZATIONS |
! SOME INITIALIZATIONS |
66 |
|
|
67 |
do k = 1, nl |
do k = 1, nl |
68 |
do i = 1, ncum |
do i = 1, ncum |
69 |
ep(i, k) = 0.0 |
ep(i, k) = 0. |
|
sigp(i, k) = spfac |
|
70 |
end do |
end do |
71 |
end do |
end do |
72 |
|
|
79 |
|
|
80 |
do i = 1, ncum |
do i = 1, ncum |
81 |
ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) & |
ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) & |
82 |
+ qnk(i) * (lv0 - clmcpv * (tnk(i) - 273.15)) + gznk(i) |
+ qnk(i) * (rlvtt - clmcpv * (tnk(i) - 273.15)) + gznk(i) |
83 |
end do |
end do |
84 |
|
|
85 |
! Find lifted parcel quantities above cloud base |
! Find lifted parcel quantities above cloud base |
89 |
if (k >= (icbs(i) + 1)) then |
if (k >= (icbs(i) + 1)) then |
90 |
tg = t(i, k) |
tg = t(i, k) |
91 |
qg = qs(i, k) |
qg = qs(i, k) |
92 |
alv = lv0 - clmcpv * (t(i, k) - 273.15) |
alv = rlvtt - clmcpv * (t(i, k) - 273.15) |
93 |
|
|
94 |
! First iteration. |
! First iteration. |
95 |
|
|
102 |
|
|
103 |
tc = tg - 273.15 |
tc = tg - 273.15 |
104 |
denom = 243.5 + tc |
denom = 243.5 + tc |
105 |
denom = MAX(denom, 1.0) |
denom = MAX(denom, 1.) |
106 |
|
|
107 |
es = 6.112 * exp(17.67 * tc / denom) |
es = 6.112 * exp(17.67 * tc / denom) |
108 |
|
|
115 |
|
|
116 |
tc = tg - 273.15 |
tc = tg - 273.15 |
117 |
denom = 243.5 + tc |
denom = 243.5 + tc |
118 |
denom = MAX(denom, 1.0) |
denom = MAX(denom, 1.) |
119 |
|
|
120 |
es = 6.112 * exp(17.67 * tc / denom) |
es = 6.112 * exp(17.67 * tc / denom) |
121 |
|
|
122 |
qg = eps * es / (p(i, k) - es * (1. - eps)) |
qg = eps * es / (p(i, k) - es * (1. - eps)) |
123 |
|
|
124 |
alv = lv0 - clmcpv * (t(i, k) - 273.15) |
alv = rlvtt - clmcpv * (t(i, k) - 273.15) |
125 |
|
|
126 |
! no approximation: |
! no approximation: |
127 |
tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) & |
tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) & |
128 |
/ (cpd + (cl - cpd) * qnk(i)) |
/ (cpd + (cl - cpd) * qnk(i)) |
129 |
|
|
130 |
clw(i, k) = qnk(i) - qg |
clw(i, k) = qnk(i) - qg |
131 |
clw(i, k) = max(0.0, clw(i, k)) |
clw(i, k) = max(0., clw(i, k)) |
132 |
! qg utilise au lieu du vrai mixing ratio rg: |
! qg utilise au lieu du vrai mixing ratio rg: |
133 |
tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing |
tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing |
134 |
endif |
endif |
135 |
end do |
end do |
136 |
end do |
end do |
137 |
|
|
138 |
! SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF |
! SET THE PRECIPITATION EFFICIENCIES |
139 |
! PRECIPITATION FALLING OUTSIDE OF CLOUD |
! It MAY BE a FUNCTION OF TP(I), P(I) AND CLW(I) |
|
! THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I) |
|
140 |
do k = 1, nl |
do k = 1, nl |
141 |
do i = 1, ncum |
do i = 1, ncum |
142 |
pden = ptcrit - pbcrit |
pden = ptcrit - pbcrit |
143 |
ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax |
ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax |
144 |
ep(i, k) = amax1(ep(i, k), 0.0) |
ep(i, k) = max(ep(i, k), 0.) |
145 |
ep(i, k) = amin1(ep(i, k), epmax) |
ep(i, k) = min(ep(i, k), epmax) |
|
sigp(i, k) = spfac |
|
146 |
end do |
end do |
147 |
end do |
end do |
148 |
|
|
152 |
! tvp est calcule en une seule fois, et sans retirer |
! tvp est calcule en une seule fois, et sans retirer |
153 |
! l'eau condensee (~> reversible CAPE) |
! l'eau condensee (~> reversible CAPE) |
154 |
do i = 1, ncum |
do i = 1, ncum |
155 |
tp(i, nlp) = tp(i, nl) |
tp(i, nl + 1) = tp(i, nl) |
156 |
end do |
end do |
157 |
|
|
158 |
! EFFECTIVE VERTICAL PROFILE OF BUOYANCY: |
! EFFECTIVE VERTICAL PROFILE OF BUOYANCY: |
175 |
buoy(icb(i), k) = buoybase(i) |
buoy(icb(i), k) = buoybase(i) |
176 |
end do |
end do |
177 |
|
|
178 |
! FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S |
! Compute inb: |
|
! LEVEL OF NEUTRAL BUOYANCY |
|
179 |
|
|
180 |
do i = 1, ncum |
inb = nl - 1 |
|
inb(i) = nl - 1 |
|
|
end do |
|
181 |
|
|
182 |
do i = 1, ncum |
do i = 1, ncum |
183 |
do k = 1, nl - 1 |
do k = 1, nl - 1 |
189 |
|
|
190 |
! CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL |
! CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL |
191 |
|
|
192 |
do k = 1, nlp |
do k = 1, nl + 1 |
193 |
do i = 1, ncum |
do i = 1, ncum |
194 |
hp(i, k) = h(i, k) |
hp(i, k) = h(i, k) |
195 |
enddo |
enddo |
197 |
|
|
198 |
do k = minorig + 1, nl |
do k = minorig + 1, nl |
199 |
do i = 1, ncum |
do i = 1, ncum |
200 |
if (k >= icb(i) .and. k <= inb(i)) hp(i, k) = h(i, nk(i)) & |
if (k >= icb(i) .and. k <= inb(i)) hp(i, k) = h(i, minorig) & |
201 |
+ (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k) |
+ (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k) |
202 |
end do |
end do |
203 |
end do |
end do |
204 |
|
|
205 |
end SUBROUTINE cv3_undilute2 |
end SUBROUTINE cv30_undilute2 |
206 |
|
|
207 |
end module cv3_undilute2_m |
end module cv30_undilute2_m |