/[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 178 - (show annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
File size: 12975 byte(s)
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.

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, 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 / .038520d0, .037196d0, .040532d0, .054934d0, .038520d0, &
95 .12613d0, .18313d0, .10357d0, .064106d0, .126130d0, &
96 .012579d0, .013649d0, .018652d0, .025181d0, .012579d0, &
97 .011890d0, .016142d0, .021105d0, .028908d0, .011890d0, &
98 .013792d0, .026810d0, .052203d0, .066338d0, .013792d0 /
99
100 DATA (AT(1, IR), IR = 1, 3) / 0.298199D-02, - .394023D-03, 0.319566D-04 /
101 DATA (BT(1, IR), IR = 1, 3) / - 0.106432D-04, 0.660324D-06, 0.174356D-06 /
102 DATA (AT(2, IR), IR = 1, 3) / 0.143676D-01, 0.366501D-02, -.160822D-02 /
103 DATA (BT(2, IR), IR = 1, 3) / -0.553979D-04, - .101701D-04, 0.920868D-05 /
104 DATA (AT(3, IR), IR = 1, 3) / 0.197861D-01, 0.315541D-02, - .174547D-02 /
105 DATA (BT(3, IR), IR = 1, 3) / - 0.877012D-04, 0.513302D-04, 0.523138D-06 /
106 DATA (AT(4, IR), IR = 1, 3) / 0.289560D-01, - .208807D-02, - .121943D-02 /
107 DATA (BT(4, IR), IR = 1, 3) / - 0.165960D-03, 0.157704D-03, - .146427D-04 /
108 DATA (AT(5, IR), IR = 1, 3) / 0.103800D-01, 0.436296D-02, - .161431D-02 /
109 DATA (BT(5, IR), IR = 1, 3) / - .276744D-04, - .327381D-04, 0.127646D-04 /
110 DATA (AT(6, IR), IR = 1, 3) / 0.868859D-02, - .972752D-03, 0.000000D-00 /
111 DATA (BT(6, IR), IR = 1, 3) / - .278412D-04, - .713940D-06, 0.117469D-05 /
112 DATA (AT(7, IR), IR = 1, 3) / 0.250073D-03, 0.455875D-03, 0.109242D-03 /
113 DATA (BT(7, IR), IR = 1, 3) / 0.199846D-05, - .216313D-05, 0.175991D-06 /
114 DATA (AT(8, IR), IR = 1, 3) / 0.307423D-01, 0.110879D-02, - .322172D-03 /
115 DATA (BT(8, IR), IR = 1, 3) / - 0.108482D-03, 0.258096D-05, - .814575D-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 JKL = KFLEV + 1 - JK
163 DO JL = 1, KDLON
164 ZXWV(JL) = MAX(PWV(JL, JK), ZEPSCQ)
165 ZXOZ(JL) = MAX(POZ(JL, JK) / PDP(JL, JK), ZEPSCO)
166 end DO
167 JKJ = (JK - 1) * NG1P1 + 1
168 JKJPN = JKJ + NG1
169 DO JKK = JKJ, JKJPN
170 DO JL = 1, KDLON
171 ZDPM = ZABLY(JL, 3, JKK)
172 ZUPM = ZABLY(JL, 5, JKK) * ZDPM / 101325.
173 ZUPMCO2 = (ZABLY(JL, 5, JKK) + PVGCO2) * ZDPM / 101325.
174 ZUPMH2O = (ZABLY(JL, 5, JKK) + PVGH2O) * ZDPM / 101325.
175 ZUPMO3 = (ZABLY(JL, 5, JKK) + PVGO3) * ZDPM / 101325.
176 ZDUC(JL, JKK) = ZDPM
177 ZABLY(JL, 12, JKK) = ZXOZ(JL) * ZDPM
178 ZABLY(JL, 13, JKK) = ZXOZ(JL) * ZUPMO3
179 ZU6 = ZXWV(JL) * ZUPM
180 ZFPPW = 1.6078 * ZXWV(JL) / (1. + 0.608 * ZXWV(JL))
181 ZABLY(JL, 6, JKK) = ZXWV(JL) * ZUPMH2O
182 ZABLY(JL, 11, JKK) = ZU6 * ZFPPW
183 ZABLY(JL, 10, JKK) = ZU6 * (1. - ZFPPW)
184 ZABLY(JL, 9, JKK) = RCO2 * ZUPMCO2
185 ZABLY(JL, 8, JKK) = RCO2 * ZDPM
186 end DO
187 end DO
188 end DO
189
190 ! 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
191
192 DO JA = 1, NUA
193 DO JL = 1, KDLON
194 PABCU(JL, JA, 3 * KFLEV + 1) = 0.
195 end DO
196 end DO
197
198 DO JK = 1, KFLEV
199 JJ = (JK - 1) * NG1P1 + 1
200 JJPN = JJ + NG1
201 JKL = KFLEV + 1 - JK
202
203 ! 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
204
205 JAE1 = 3 * KFLEV + 1 - JJ
206 JAE2 = 3 * KFLEV + 1 - (JJ + 1)
207 JAE3 = 3 * KFLEV + 1 - JJPN
208 DO JAE = 1, 5
209 DO JL = 1, KDLON
210 ZUAER(JL, JAE) = (RAER(JAE, 1) * PAER(JL, JKL, 1) &
211 + RAER(JAE, 2) * PAER(JL, JKL, 2) &
212 + RAER(JAE, 3) * PAER(JL, JKL, 3) &
213 + RAER(JAE, 4) * PAER(JL, JKL, 4) &
214 + RAER(JAE, 5) * PAER(JL, JKL, 5)) &
215 / (ZDUC(JL, JAE1) + ZDUC(JL, JAE2) + ZDUC(JL, JAE3))
216 end DO
217 end DO
218
219 ! 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
220
221 DO JL = 1, KDLON
222 ZTAVI(JL) = PTAVE(JL, JKL)
223 ZTCON(JL) = EXP(6.08 * (296. / ZTAVI(JL) - 1.))
224 ZTX = ZTAVI(JL) - TREF
225 ZTX2 = ZTX * ZTX
226 ZZABLY = ZABLY(JL, 6, JAE1) + ZABLY(JL, 6, JAE2) + ZABLY(JL, 6, JAE3)
227 ZUP = MIN(MAX(0.5 * R10E * LOG(ZZABLY) + 5., 0d0), 6d0)
228 ZCAH1 = AT(1, 1) + ZUP * (AT(1, 2) + ZUP * (AT(1, 3)))
229 ZCBH1 = BT(1, 1) + ZUP * (BT(1, 2) + ZUP * (BT(1, 3)))
230 ZPSH1(JL) = EXP(ZCAH1 * ZTX + ZCBH1 * ZTX2)
231 ZCAH2 = AT(2, 1) + ZUP * (AT(2, 2) + ZUP * (AT(2, 3)))
232 ZCBH2 = BT(2, 1) + ZUP * (BT(2, 2) + ZUP * (BT(2, 3)))
233 ZPSH2(JL) = EXP(ZCAH2 * ZTX + ZCBH2 * ZTX2)
234 ZCAH3 = AT(3, 1) + ZUP * (AT(3, 2) + ZUP * (AT(3, 3)))
235 ZCBH3 = BT(3, 1) + ZUP * (BT(3, 2) + ZUP * (BT(3, 3)))
236 ZPSH3(JL) = EXP(ZCAH3 * ZTX + ZCBH3 * ZTX2)
237 ZCAH4 = AT(4, 1) + ZUP * (AT(4, 2) + ZUP * (AT(4, 3)))
238 ZCBH4 = BT(4, 1) + ZUP * (BT(4, 2) + ZUP * (BT(4, 3)))
239 ZPSH4(JL) = EXP(ZCAH4 * ZTX + ZCBH4 * ZTX2)
240 ZCAH5 = AT(5, 1) + ZUP * (AT(5, 2) + ZUP * (AT(5, 3)))
241 ZCBH5 = BT(5, 1) + ZUP * (BT(5, 2) + ZUP * (BT(5, 3)))
242 ZPSH5(JL) = EXP(ZCAH5 * ZTX + ZCBH5 * ZTX2)
243 ZCAH6 = AT(6, 1) + ZUP * (AT(6, 2) + ZUP * (AT(6, 3)))
244 ZCBH6 = BT(6, 1) + ZUP * (BT(6, 2) + ZUP * (BT(6, 3)))
245 ZPSH6(JL) = EXP(ZCAH6 * ZTX + ZCBH6 * ZTX2)
246 ZPHM6(JL) = EXP(- 5.81E-4 * ZTX - 1.13E-6 * ZTX2)
247 ZPSM6(JL) = EXP(- 5.57E-4 * ZTX - 3.30E-6 * ZTX2)
248 ZPHN6(JL) = EXP(- 3.46E-5 * ZTX + 2.05E-7 * ZTX2)
249 ZPSN6(JL) = EXP(3.70E-3 * ZTX - 2.30E-6 * ZTX2)
250 end DO
251
252 DO JL = 1, KDLON
253 ZTAVI(JL) = PTAVE(JL, JKL)
254 ZTX = ZTAVI(JL) - TREF
255 ZTX2 = ZTX * ZTX
256 ZZABLY = ZABLY(JL, 9, JAE1) + ZABLY(JL, 9, JAE2) + ZABLY(JL, 9, JAE3)
257 ZALUP = R10E * LOG(ZZABLY)
258 ZUP = MAX(0d0, 5.0 + 0.5 * ZALUP)
259 ZPSC2(JL) = (ZTAVI(JL) / TREF) ** ZUP
260 ZCAC8 = AT(8, 1) + ZUP * (AT(8, 2) + ZUP * (AT(8, 3)))
261 ZCBC8 = BT(8, 1) + ZUP * (BT(8, 2) + ZUP * (BT(8, 3)))
262 ZPSC3(JL) = EXP(ZCAC8 * ZTX + ZCBC8 * ZTX2)
263 ZPHIO(JL) = EXP(OCT(1) * ZTX + OCT(2) * ZTX2)
264 ZPSIO(JL) = EXP(2. * (OCT(3) * ZTX + OCT(4) * ZTX2))
265 end DO
266
267 DO JKK = JJ, JJPN
268 JC = 3 * KFLEV + 1 - JKK
269 JCP1 = JC + 1
270 DO JL = 1, KDLON
271 ZDIFF = PVIEW(JL)
272 PABCU(JL, 10, JC) = PABCU(JL, 10, JCP1) &
273 + ZABLY(JL, 10, JC) * ZDIFF
274 PABCU(JL, 11, JC) = PABCU(JL, 11, JCP1) &
275 + ZABLY(JL, 11, JC) * ZTCON(JL) * ZDIFF
276
277 PABCU(JL, 12, JC) = PABCU(JL, 12, JCP1) &
278 + ZABLY(JL, 12, JC) * ZPHIO(JL) * ZDIFF
279 PABCU(JL, 13, JC) = PABCU(JL, 13, JCP1) &
280 + ZABLY(JL, 13, JC) * ZPSIO(JL) * ZDIFF
281
282 PABCU(JL, 7, JC) = PABCU(JL, 7, JCP1) &
283 + ZABLY(JL, 9, JC) * ZPSC2(JL) * ZDIFF
284 PABCU(JL, 8, JC) = PABCU(JL, 8, JCP1) &
285 + ZABLY(JL, 9, JC) * ZPSC3(JL) * ZDIFF
286 PABCU(JL, 9, JC) = PABCU(JL, 9, JCP1) &
287 + ZABLY(JL, 9, JC) * ZPSC3(JL) * ZDIFF
288
289 PABCU(JL, 1, JC) = PABCU(JL, 1, JCP1) &
290 + ZABLY(JL, 6, JC) * ZPSH1(JL) * ZDIFF
291 PABCU(JL, 2, JC) = PABCU(JL, 2, JCP1) &
292 + ZABLY(JL, 6, JC) * ZPSH2(JL) * ZDIFF
293 PABCU(JL, 3, JC) = PABCU(JL, 3, JCP1) &
294 + ZABLY(JL, 6, JC) * ZPSH5(JL) * ZDIFF
295 PABCU(JL, 4, JC) = PABCU(JL, 4, JCP1) &
296 + ZABLY(JL, 6, JC) * ZPSH3(JL) * ZDIFF
297 PABCU(JL, 5, JC) = PABCU(JL, 5, JCP1) &
298 + ZABLY(JL, 6, JC) * ZPSH4(JL) * ZDIFF
299 PABCU(JL, 6, JC) = PABCU(JL, 6, JCP1) &
300 + ZABLY(JL, 6, JC) * ZPSH6(JL) * ZDIFF
301
302 PABCU(JL, 14, JC) = PABCU(JL, 14, JCP1) &
303 + ZUAER(JL, 1) * ZDUC(JL, JC) * ZDIFF
304 PABCU(JL, 15, JC) = PABCU(JL, 15, JCP1) &
305 + ZUAER(JL, 2) * ZDUC(JL, JC) * ZDIFF
306 PABCU(JL, 16, JC) = PABCU(JL, 16, JCP1) &
307 + ZUAER(JL, 3) * ZDUC(JL, JC) * ZDIFF
308 PABCU(JL, 17, JC) = PABCU(JL, 17, JCP1) &
309 + ZUAER(JL, 4) * ZDUC(JL, JC) * ZDIFF
310 PABCU(JL, 18, JC) = PABCU(JL, 18, JCP1) &
311 + ZUAER(JL, 5) * ZDUC(JL, JC) * ZDIFF
312
313 PABCU(JL, 19, JC) = PABCU(JL, 19, JCP1) &
314 + ZABLY(JL, 8, JC) * RCH4 / RCO2 * ZPHM6(JL) * ZDIFF
315 PABCU(JL, 20, JC) = PABCU(JL, 20, JCP1) &
316 + ZABLY(JL, 9, JC) * RCH4 / RCO2 * ZPSM6(JL) * ZDIFF
317 PABCU(JL, 21, JC) = PABCU(JL, 21, JCP1) &
318 + ZABLY(JL, 8, JC) * RN2O / RCO2 * ZPHN6(JL) * ZDIFF
319 PABCU(JL, 22, JC) = PABCU(JL, 22, JCP1) &
320 + ZABLY(JL, 9, JC) * RN2O / RCO2 * ZPSN6(JL) * ZDIFF
321
322 PABCU(JL, 23, JC) = PABCU(JL, 23, JCP1) &
323 + ZABLY(JL, 8, JC) * RCFC11 / RCO2 * ZDIFF
324 PABCU(JL, 24, JC) = PABCU(JL, 24, JCP1) &
325 + ZABLY(JL, 8, JC) * RCFC12 / RCO2 * ZDIFF
326 end DO
327 end DO
328 end DO
329
330 END SUBROUTINE LWU
331
332 end module LWU_m

  ViewVC Help
Powered by ViewVC 1.1.21