/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwu.f
ViewVC logotype

Contents of /trunk/Sources/phylmd/Radlwsw/lwu.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 139 - (show annotations)
Tue May 26 17:46:03 2015 UTC (9 years ago) by guez
File size: 12952 byte(s) 
dynetat0 read rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d from
"start.nc" and then these variables were overwritten by
inigeom. Corrected this. Now, inigeom does not compute rlonu, rlatu,
rlonv and rlatv. Moreover, cu_2d, cv_2d, aire_2d are not written to
"restart.nc". Since xprimu, xprimv, xprimm025, xprimp025, rlatu1,
rlatu2, yprimu1, yprimu2 are computed at the same time as rlonu,
rlatu, rlonv, rlatv, and since it would not be convenient to separate
those computations, we decide to write xprimu, xprimv, xprimm025,
xprimp025, rlatu1, rlatu2, yprimu1, yprimu2 into "restart.nc", read
them from "start.nc" and not compute them in inigeom. So, in summary,
"start.nc" contains all the coordinates and their derivatives, and
inigeom only computes the 2D-variables.

Technical details:

Moved variables rlatu, rlonv, rlonu, rlatv, xprimu, xprimv from module
comgeom to module dynetat0_m. Upgraded local variables rlatu1,
yprimu1, rlatu2, yprimu2, xprimm025, xprimp025 of procedure inigeom to
variables of module dynetat0_m.

Removed unused local variable yprimu of procedure inigeom and
corresponding argument yyprimu of fyhyp.

Moved variables clat, clon, grossismx, grossismy, dzoomx, dzoomy,
taux, tauy from module serre to module dynetat0_m (since they are read
from "start.nc"). The default values are now defined in read_serre
instead of in the declarations. Changed name of module serre to
read_serre_m, no more module variable here.

The calls to fxhyp and fyhyp are moved from inigeom to etat0.

Side effects in programs other than gcm: etat0 and read_serre write
variables of module dynetat0; the programs test_fxyp and
test_inter_barxy need more source files.

Removed unused arguments len and nd of cv3_tracer. Removed unused
argument PPSOL of LWU.

Bug fix in test_inter_barxy: forgotten call to read_serre.
1 module LWU_m
2
3 IMPLICIT none
4
5 contains
6
7 SUBROUTINE LWU(PAER, PDP, PPMB, POZ, PTAVE, PVIEW, PWV, PABCU)
8
9 ! Purpose. Computes absorber amounts including pressure and
10 ! temperature effects.
11
12 ! Method. Computes the pressure and temperature weighted amounts
13 ! of absorbers.
14
15 ! Reference. See radiation's part of the model's documentation and
16 ! ECMWF research department documentation of the IFS.
17
18 ! Author. Jean-Jacques Morcrette, ECMWF.
19
20 ! Modifications.
21 ! Original : 89-07-14
22 ! Voigt lines (loop 404 modified) - JJM & PhD - 01/96
23
24 USE clesphys, ONLY: rcfc11, rcfc12, rch4, rco2, rn2o
25 USE suphec_m, ONLY: rg
26 USE raddim, ONLY: kdlon, kflev
27 USE radepsi, ONLY: zepsco, zepscq
28 USE radopt, ONLY: levoigt
29 USE raddimlw, ONLY: ng1, ng1p1, ninter, nua
30
31 ! ARGUMENTS:
32
33 DOUBLE PRECISION PAER(KDLON, KFLEV, 5)
34 DOUBLE PRECISION PDP(KDLON, KFLEV)
35 DOUBLE PRECISION PPMB(KDLON, KFLEV + 1)
36 DOUBLE PRECISION POZ(KDLON, KFLEV)
37 DOUBLE PRECISION PTAVE(KDLON, KFLEV)
38 DOUBLE PRECISION PVIEW(KDLON)
39 DOUBLE PRECISION PWV(KDLON, KFLEV)
40
41 DOUBLE PRECISION PABCU(KDLON, NUA, 3 * KFLEV + 1)
42 ! effective absorber amounts
43
44 ! LOCAL VARIABLES:
45
46 DOUBLE PRECISION ZABLY(KDLON, NUA, 3 * KFLEV + 1)
47 DOUBLE PRECISION ZDUC(KDLON, 3 * KFLEV + 1)
48 DOUBLE PRECISION ZPHIO(KDLON)
49 DOUBLE PRECISION ZPSC2(KDLON)
50 DOUBLE PRECISION ZPSC3(KDLON)
51 DOUBLE PRECISION ZPSH1(KDLON)
52 DOUBLE PRECISION ZPSH2(KDLON)
53 DOUBLE PRECISION ZPSH3(KDLON)
54 DOUBLE PRECISION ZPSH4(KDLON)
55 DOUBLE PRECISION ZPSH5(KDLON)
56 DOUBLE PRECISION ZPSH6(KDLON)
57 DOUBLE PRECISION ZPSIO(KDLON)
58 DOUBLE PRECISION ZTCON(KDLON)
59 DOUBLE PRECISION ZPHM6(KDLON)
60 DOUBLE PRECISION ZPSM6(KDLON)
61 DOUBLE PRECISION ZPHN6(KDLON)
62 DOUBLE PRECISION ZPSN6(KDLON)
63 DOUBLE PRECISION ZSSIG(KDLON, 3 * KFLEV + 1)
64 DOUBLE PRECISION ZTAVI(KDLON)
65 DOUBLE PRECISION ZUAER(KDLON, Ninter)
66 DOUBLE PRECISION ZXOZ(KDLON)
67 DOUBLE PRECISION ZXWV(KDLON)
68
69 INTEGER jl, jk, jkj, jkjr, jkjp, ig1
70 INTEGER jki, jkip1, ja, jj
71 INTEGER jkl, jkp1, jkk, jkjpn
72 INTEGER jae1, jae2, jae3, jae, jjpn
73 INTEGER ir, jc, jcp1
74 DOUBLE PRECISION zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
75 DOUBLE PRECISION zfppw, ztx, ztx2, zzably
76 DOUBLE PRECISION zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
77 DOUBLE PRECISION zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
78 DOUBLE PRECISION zcac8, zcbc8
79 DOUBLE PRECISION zalup, zdiff
80
81 DOUBLE PRECISION PVGCO2, PVGH2O, PVGO3
82
83 DOUBLE PRECISION, PARAMETER:: R10E = 0.4342945
84 ! decimal / natural logarithm factor
85
86 ! Used Data Block:
87
88 DOUBLE PRECISION:: TREF = 250d0
89 DOUBLE PRECISION:: RT1(2) = (/ - 0.577350269d0, 0.577350269d0/)
90 DOUBLE PRECISION RAER(5, 5)
91 DOUBLE PRECISION AT(8, 3), BT(8, 3)
92 DOUBLE PRECISION:: OCT(4) = (/- 0.326D-3, - 0.102D-5, 0.137D-2, - 0.535D-5/)
93
94 DATA RAER / .038520, .037196, .040532, .054934, .038520, &
95 .12613, .18313, .10357, .064106, .126130, &
96 .012579, .013649, .018652, .025181, .012579, &
97 .011890, .016142, .021105, .028908, .011890, &
98 .013792, .026810, .052203, .066338, .013792 /
99
100 DATA (AT(1, IR), IR = 1, 3) / 0.298199E-02, - .394023E-03, 0.319566E-04 /
101 DATA (BT(1, IR), IR = 1, 3) / - 0.106432E-04, 0.660324E-06, 0.174356E-06 /
102 DATA (AT(2, IR), IR = 1, 3) / 0.143676E-01, 0.366501E-02, -.160822E-02 /
103 DATA (BT(2, IR), IR = 1, 3) / -0.553979E-04, - .101701E-04, 0.920868E-05 /
104 DATA (AT(3, IR), IR = 1, 3) / 0.197861E-01, 0.315541E-02, - .174547E-02 /
105 DATA (BT(3, IR), IR = 1, 3) / - 0.877012E-04, 0.513302E-04, 0.523138E-06 /
106 DATA (AT(4, IR), IR = 1, 3) / 0.289560E-01, - .208807E-02, - .121943E-02 /
107 DATA (BT(4, IR), IR = 1, 3) / - 0.165960E-03, 0.157704E-03, - .146427E-04 /
108 DATA (AT(5, IR), IR = 1, 3) / 0.103800E-01, 0.436296E-02, - .161431E-02 /
109 DATA (BT(5, IR), IR = 1, 3) / - .276744E-04, - .327381E-04, 0.127646E-04 /
110 DATA (AT(6, IR), IR = 1, 3) / 0.868859E-02, - .972752E-03, 0.000000E-00 /
111 DATA (BT(6, IR), IR = 1, 3) / - .278412E-04, - .713940E-06, 0.117469E-05 /
112 DATA (AT(7, IR), IR = 1, 3) / 0.250073E-03, 0.455875E-03, 0.109242E-03 /
113 DATA (BT(7, IR), IR = 1, 3) / 0.199846E-05, - .216313E-05, 0.175991E-06 /
114 DATA (AT(8, IR), IR = 1, 3) / 0.307423E-01, 0.110879E-02, - .322172E-03 /
115 DATA (BT(8, IR), IR = 1, 3) / - 0.108482E-03, 0.258096E-05, - .814575E-06 /
116
117 !-----------------------------------------------------------------------
118
119 IF (LEVOIGT) THEN
120 PVGCO2 = 60.
121 PVGH2O = 30.
122 PVGO3 = 400.
123 ELSE
124 PVGCO2 = 0.
125 PVGH2O = 0.
126 PVGO3 = 0.
127 ENDIF
128
129 ! 2. PRESSURE OVER GAUSS SUB-LEVELS
130
131 DO JL = 1, KDLON
132 ZSSIG(JL, 1) = PPMB(JL, 1) * 100.
133 end DO
134
135 DO JK = 1, KFLEV
136 JKJ = (JK - 1) * NG1P1 + 1
137 JKJR = JKJ
138 JKJP = JKJ + NG1P1
139 DO JL = 1, KDLON
140 ZSSIG(JL, JKJP) = PPMB(JL, JK + 1) * 100.
141 end DO
142 DO IG1 = 1, NG1
143 JKJ = JKJ + 1
144 DO JL = 1, KDLON
145 ZSSIG(JL, JKJ) = (ZSSIG(JL, JKJR) + ZSSIG(JL, JKJP)) * 0.5 &
146 + RT1(IG1) * (ZSSIG(JL, JKJP) - ZSSIG(JL, JKJR)) * 0.5
147 end DO
148 end DO
149 end DO
150
151 ! 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
152
153 DO JKI = 1, 3 * KFLEV
154 JKIP1 = JKI + 1
155 DO JL = 1, KDLON
156 ZABLY(JL, 5, JKI) = (ZSSIG(JL, JKI) + ZSSIG(JL, JKIP1)) * 0.5
157 ZABLY(JL, 3, JKI) = (ZSSIG(JL, JKI) - ZSSIG(JL, JKIP1)) / (10. * RG)
158 end DO
159 end DO
160
161 DO JK = 1, KFLEV
162 JKP1 = JK + 1
163 JKL = KFLEV + 1 - JK
164 DO JL = 1, KDLON
165 ZXWV(JL) = MAX(PWV(JL, JK), ZEPSCQ)
166 ZXOZ(JL) = MAX(POZ(JL, JK) / PDP(JL, JK), ZEPSCO)
167 end DO
168 JKJ = (JK - 1) * NG1P1 + 1
169 JKJPN = JKJ + NG1
170 DO JKK = JKJ, JKJPN
171 DO JL = 1, KDLON
172 ZDPM = ZABLY(JL, 3, JKK)
173 ZUPM = ZABLY(JL, 5, JKK) * ZDPM / 101325.
174 ZUPMCO2 = (ZABLY(JL, 5, JKK) + PVGCO2) * ZDPM / 101325.
175 ZUPMH2O = (ZABLY(JL, 5, JKK) + PVGH2O) * ZDPM / 101325.
176 ZUPMO3 = (ZABLY(JL, 5, JKK) + PVGO3) * ZDPM / 101325.
177 ZDUC(JL, JKK) = ZDPM
178 ZABLY(JL, 12, JKK) = ZXOZ(JL) * ZDPM
179 ZABLY(JL, 13, JKK) = ZXOZ(JL) * ZUPMO3
180 ZU6 = ZXWV(JL) * ZUPM
181 ZFPPW = 1.6078 * ZXWV(JL) / (1. + 0.608 * ZXWV(JL))
182 ZABLY(JL, 6, JKK) = ZXWV(JL) * ZUPMH2O
183 ZABLY(JL, 11, JKK) = ZU6 * ZFPPW
184 ZABLY(JL, 10, JKK) = ZU6 * (1. - ZFPPW)
185 ZABLY(JL, 9, JKK) = RCO2 * ZUPMCO2
186 ZABLY(JL, 8, JKK) = RCO2 * ZDPM
187 end DO
188 end DO
189 end DO
190
191 ! 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
192
193 DO JA = 1, NUA
194 DO JL = 1, KDLON
195 PABCU(JL, JA, 3 * KFLEV + 1) = 0.
196 end DO
197 end DO
198
199 DO JK = 1, KFLEV
200 JJ = (JK - 1) * NG1P1 + 1
201 JJPN = JJ + NG1
202 JKL = KFLEV + 1 - JK
203
204 ! 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
205
206 JAE1 = 3 * KFLEV + 1 - JJ
207 JAE2 = 3 * KFLEV + 1 - (JJ + 1)
208 JAE3 = 3 * KFLEV + 1 - JJPN
209 DO JAE = 1, 5
210 DO JL = 1, KDLON
211 ZUAER(JL, JAE) = (RAER(JAE, 1) * PAER(JL, JKL, 1) &
212 + RAER(JAE, 2) * PAER(JL, JKL, 2) &
213 + RAER(JAE, 3) * PAER(JL, JKL, 3) &
214 + RAER(JAE, 4) * PAER(JL, JKL, 4) &
215 + RAER(JAE, 5) * PAER(JL, JKL, 5)) &
216 / (ZDUC(JL, JAE1) + ZDUC(JL, JAE2) + ZDUC(JL, JAE3))
217 end DO
218 end DO
219
220 ! 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
221
222 DO JL = 1, KDLON
223 ZTAVI(JL) = PTAVE(JL, JKL)
224 ZTCON(JL) = EXP(6.08 * (296. / ZTAVI(JL) - 1.))
225 ZTX = ZTAVI(JL) - TREF
226 ZTX2 = ZTX * ZTX
227 ZZABLY = ZABLY(JL, 6, JAE1) + ZABLY(JL, 6, JAE2) + ZABLY(JL, 6, JAE3)
228 ZUP = MIN(MAX(0.5 * R10E * LOG(ZZABLY) + 5., 0d0), 6d0)
229 ZCAH1 = AT(1, 1) + ZUP * (AT(1, 2) + ZUP * (AT(1, 3)))
230 ZCBH1 = BT(1, 1) + ZUP * (BT(1, 2) + ZUP * (BT(1, 3)))
231 ZPSH1(JL) = EXP(ZCAH1 * ZTX + ZCBH1 * ZTX2)
232 ZCAH2 = AT(2, 1) + ZUP * (AT(2, 2) + ZUP * (AT(2, 3)))
233 ZCBH2 = BT(2, 1) + ZUP * (BT(2, 2) + ZUP * (BT(2, 3)))
234 ZPSH2(JL) = EXP(ZCAH2 * ZTX + ZCBH2 * ZTX2)
235 ZCAH3 = AT(3, 1) + ZUP * (AT(3, 2) + ZUP * (AT(3, 3)))
236 ZCBH3 = BT(3, 1) + ZUP * (BT(3, 2) + ZUP * (BT(3, 3)))
237 ZPSH3(JL) = EXP(ZCAH3 * ZTX + ZCBH3 * ZTX2)
238 ZCAH4 = AT(4, 1) + ZUP * (AT(4, 2) + ZUP * (AT(4, 3)))
239 ZCBH4 = BT(4, 1) + ZUP * (BT(4, 2) + ZUP * (BT(4, 3)))
240 ZPSH4(JL) = EXP(ZCAH4 * ZTX + ZCBH4 * ZTX2)
241 ZCAH5 = AT(5, 1) + ZUP * (AT(5, 2) + ZUP * (AT(5, 3)))
242 ZCBH5 = BT(5, 1) + ZUP * (BT(5, 2) + ZUP * (BT(5, 3)))
243 ZPSH5(JL) = EXP(ZCAH5 * ZTX + ZCBH5 * ZTX2)
244 ZCAH6 = AT(6, 1) + ZUP * (AT(6, 2) + ZUP * (AT(6, 3)))
245 ZCBH6 = BT(6, 1) + ZUP * (BT(6, 2) + ZUP * (BT(6, 3)))
246 ZPSH6(JL) = EXP(ZCAH6 * ZTX + ZCBH6 * ZTX2)
247 ZPHM6(JL) = EXP(- 5.81E-4 * ZTX - 1.13E-6 * ZTX2)
248 ZPSM6(JL) = EXP(- 5.57E-4 * ZTX - 3.30E-6 * ZTX2)
249 ZPHN6(JL) = EXP(- 3.46E-5 * ZTX + 2.05E-7 * ZTX2)
250 ZPSN6(JL) = EXP(3.70E-3 * ZTX - 2.30E-6 * ZTX2)
251 end DO
252
253 DO JL = 1, KDLON
254 ZTAVI(JL) = PTAVE(JL, JKL)
255 ZTX = ZTAVI(JL) - TREF
256 ZTX2 = ZTX * ZTX
257 ZZABLY = ZABLY(JL, 9, JAE1) + ZABLY(JL, 9, JAE2) + ZABLY(JL, 9, JAE3)
258 ZALUP = R10E * LOG(ZZABLY)
259 ZUP = MAX(0d0, 5.0 + 0.5 * ZALUP)
260 ZPSC2(JL) = (ZTAVI(JL) / TREF) ** ZUP
261 ZCAC8 = AT(8, 1) + ZUP * (AT(8, 2) + ZUP * (AT(8, 3)))
262 ZCBC8 = BT(8, 1) + ZUP * (BT(8, 2) + ZUP * (BT(8, 3)))
263 ZPSC3(JL) = EXP(ZCAC8 * ZTX + ZCBC8 * ZTX2)
264 ZPHIO(JL) = EXP(OCT(1) * ZTX + OCT(2) * ZTX2)
265 ZPSIO(JL) = EXP(2. * (OCT(3) * ZTX + OCT(4) * ZTX2))
266 end DO
267
268 DO JKK = JJ, JJPN
269 JC = 3 * KFLEV + 1 - JKK
270 JCP1 = JC + 1
271 DO JL = 1, KDLON
272 ZDIFF = PVIEW(JL)
273 PABCU(JL, 10, JC) = PABCU(JL, 10, JCP1) &
274 + ZABLY(JL, 10, JC) * ZDIFF
275 PABCU(JL, 11, JC) = PABCU(JL, 11, JCP1) &
276 + ZABLY(JL, 11, JC) * ZTCON(JL) * ZDIFF
277
278 PABCU(JL, 12, JC) = PABCU(JL, 12, JCP1) &
279 + ZABLY(JL, 12, JC) * ZPHIO(JL) * ZDIFF
280 PABCU(JL, 13, JC) = PABCU(JL, 13, JCP1) &
281 + ZABLY(JL, 13, JC) * ZPSIO(JL) * ZDIFF
282
283 PABCU(JL, 7, JC) = PABCU(JL, 7, JCP1) &
284 + ZABLY(JL, 9, JC) * ZPSC2(JL) * ZDIFF
285 PABCU(JL, 8, JC) = PABCU(JL, 8, JCP1) &
286 + ZABLY(JL, 9, JC) * ZPSC3(JL) * ZDIFF
287 PABCU(JL, 9, JC) = PABCU(JL, 9, JCP1) &
288 + ZABLY(JL, 9, JC) * ZPSC3(JL) * ZDIFF
289
290 PABCU(JL, 1, JC) = PABCU(JL, 1, JCP1) &
291 + ZABLY(JL, 6, JC) * ZPSH1(JL) * ZDIFF
292 PABCU(JL, 2, JC) = PABCU(JL, 2, JCP1) &
293 + ZABLY(JL, 6, JC) * ZPSH2(JL) * ZDIFF
294 PABCU(JL, 3, JC) = PABCU(JL, 3, JCP1) &
295 + ZABLY(JL, 6, JC) * ZPSH5(JL) * ZDIFF
296 PABCU(JL, 4, JC) = PABCU(JL, 4, JCP1) &
297 + ZABLY(JL, 6, JC) * ZPSH3(JL) * ZDIFF
298 PABCU(JL, 5, JC) = PABCU(JL, 5, JCP1) &
299 + ZABLY(JL, 6, JC) * ZPSH4(JL) * ZDIFF
300 PABCU(JL, 6, JC) = PABCU(JL, 6, JCP1) &
301 + ZABLY(JL, 6, JC) * ZPSH6(JL) * ZDIFF
302
303 PABCU(JL, 14, JC) = PABCU(JL, 14, JCP1) &
304 + ZUAER(JL, 1) * ZDUC(JL, JC) * ZDIFF
305 PABCU(JL, 15, JC) = PABCU(JL, 15, JCP1) &
306 + ZUAER(JL, 2) * ZDUC(JL, JC) * ZDIFF
307 PABCU(JL, 16, JC) = PABCU(JL, 16, JCP1) &
308 + ZUAER(JL, 3) * ZDUC(JL, JC) * ZDIFF
309 PABCU(JL, 17, JC) = PABCU(JL, 17, JCP1) &
310 + ZUAER(JL, 4) * ZDUC(JL, JC) * ZDIFF
311 PABCU(JL, 18, JC) = PABCU(JL, 18, JCP1) &
312 + ZUAER(JL, 5) * ZDUC(JL, JC) * ZDIFF
313
314 PABCU(JL, 19, JC) = PABCU(JL, 19, JCP1) &
315 + ZABLY(JL, 8, JC) * RCH4 / RCO2 * ZPHM6(JL) * ZDIFF
316 PABCU(JL, 20, JC) = PABCU(JL, 20, JCP1) &
317 + ZABLY(JL, 9, JC) * RCH4 / RCO2 * ZPSM6(JL) * ZDIFF
318 PABCU(JL, 21, JC) = PABCU(JL, 21, JCP1) &
319 + ZABLY(JL, 8, JC) * RN2O / RCO2 * ZPHN6(JL) * ZDIFF
320 PABCU(JL, 22, JC) = PABCU(JL, 22, JCP1) &
321 + ZABLY(JL, 9, JC) * RN2O / RCO2 * ZPSN6(JL) * ZDIFF
322
323 PABCU(JL, 23, JC) = PABCU(JL, 23, JCP1) &
324 + ZABLY(JL, 8, JC) * RCFC11 / RCO2 * ZDIFF
325 PABCU(JL, 24, JC) = PABCU(JL, 24, JCP1) &
326 + ZABLY(JL, 8, JC) * RCFC12 / RCO2 * ZDIFF
327 end DO
328 end DO
329 end DO
330
331 END SUBROUTINE LWU
332
333 end module LWU_m
  ViewVC Help
Powered by ViewVC 1.1.21