/[lmdze]/trunk/libf/phylmd/Radlwsw/lwu.f90
ViewVC logotype

Contents of /trunk/libf/phylmd/Radlwsw/lwu.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (show annotations)
Mon Jul 8 18:12:18 2013 UTC (10 years, 9 months ago) by guez
File size: 12993 byte(s)
No reason to call inidissip in ce0l.

In inidissip, set random seed to 1 beacuse PGI compiler does not
accept all zeros.

dq was computed needlessly in caladvtrac. Arguments masse and dq of
calfis not used.

Replaced real*8 by double precision.

Pass arrays with inverted order of vertical levels to conflx instead
of creating local variables for this inside conflx.

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

  ViewVC Help
Powered by ViewVC 1.1.21