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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 38 - (show annotations)
Thu Jan 6 17:52:19 2011 UTC (13 years, 3 months ago) by guez
File size: 12745 byte(s)
Extracted ASCII art from "inigeom" into a separate text file in the
documentation.

"test_disvert" now creates a separate file for layer thicknesses.

Moved variables from module "yomcst" to module "suphec_m" because this
is where those variables are defined. Kept in "yomcst" only parameters
of Earth orbit. Gave the attribute "parameter" to some variables of
module "suphec_m".

Variables of module "yoethf" were defined in procedure "suphec". Moved
these definitions to a new procedure "yoethf" in module "yoethf_m".

1 cIM ctes ds clesphys.h SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12,
2 SUBROUTINE LWU(
3 S PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV,
4 S PABCU)
5 use dimens_m
6 use dimphy
7 use clesphys
8 use SUPHEC_M
9 use raddim
10 use radepsi
11 use radopt
12 use raddimlw
13 IMPLICIT none
14 C
15 C PURPOSE.
16 C --------
17 C COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
18 C TEMPERATURE EFFECTS
19 C
20 C METHOD.
21 C -------
22 C
23 C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
24 C ABSORBERS.
25 C
26 C
27 C REFERENCE.
28 C ----------
29 C
30 C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
31 C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
32 C
33 C AUTHOR.
34 C -------
35 C JEAN-JACQUES MORCRETTE *ECMWF*
36 C
37 C MODIFICATIONS.
38 C --------------
39 C ORIGINAL : 89-07-14
40 C Voigt lines (loop 404 modified) - JJM & PhD - 01/96
41 C-----------------------------------------------------------------------
42 C* ARGUMENTS:
43 cIM ctes ds clesphys.h
44 c REAL*8 RCO2
45 c REAL*8 RCH4, RN2O, RCFC11, RCFC12
46 REAL*8 PAER(KDLON,KFLEV,5)
47 REAL*8 PDP(KDLON,KFLEV)
48 REAL*8 PPMB(KDLON,KFLEV+1)
49 REAL*8 PPSOL(KDLON)
50 REAL*8 POZ(KDLON,KFLEV)
51 REAL*8 PTAVE(KDLON,KFLEV)
52 REAL*8 PVIEW(KDLON)
53 REAL*8 PWV(KDLON,KFLEV)
54 C
55 REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
56 C
57 C-----------------------------------------------------------------------
58 C* LOCAL VARIABLES:
59 REAL*8 ZABLY(KDLON,NUA,3*KFLEV+1)
60 REAL*8 ZDUC(KDLON,3*KFLEV+1)
61 REAL*8 ZPHIO(KDLON)
62 REAL*8 ZPSC2(KDLON)
63 REAL*8 ZPSC3(KDLON)
64 REAL*8 ZPSH1(KDLON)
65 REAL*8 ZPSH2(KDLON)
66 REAL*8 ZPSH3(KDLON)
67 REAL*8 ZPSH4(KDLON)
68 REAL*8 ZPSH5(KDLON)
69 REAL*8 ZPSH6(KDLON)
70 REAL*8 ZPSIO(KDLON)
71 REAL*8 ZTCON(KDLON)
72 REAL*8 ZPHM6(KDLON)
73 REAL*8 ZPSM6(KDLON)
74 REAL*8 ZPHN6(KDLON)
75 REAL*8 ZPSN6(KDLON)
76 REAL*8 ZSSIG(KDLON,3*KFLEV+1)
77 REAL*8 ZTAVI(KDLON)
78 REAL*8 ZUAER(KDLON,Ninter)
79 REAL*8 ZXOZ(KDLON)
80 REAL*8 ZXWV(KDLON)
81 C
82 INTEGER jl, jk, jkj, jkjr, jkjp, ig1
83 INTEGER jki, jkip1, ja, jj
84 INTEGER jkl, jkp1, jkk, jkjpn
85 INTEGER jae1, jae2, jae3, jae, jjpn
86 INTEGER ir, jc, jcp1
87 REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
88 REAL*8 zfppw, ztx, ztx2, zzably
89 REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
90 REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
91 REAL*8 zcac8, zcbc8
92 REAL*8 zalup, zdiff
93 c
94 REAL*8 PVGCO2, PVGH2O, PVGO3
95 C
96 REAL*8 R10E ! DECIMAL/NATURAL LOG.FACTOR
97 PARAMETER (R10E=0.4342945)
98 c
99 c Used Data Block:
100 c
101 REAL*8 TREF
102 SAVE TREF
103 REAL*8 RT1(2)
104 SAVE RT1
105 REAL*8 RAER(5,5)
106 SAVE RAER
107 REAL*8 AT(8,3), BT(8,3)
108 SAVE AT, BT
109 REAL*8 OCT(4)
110 SAVE OCT
111 DATA TREF /250.0/
112 DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
113 DATA RAER / .038520, .037196, .040532, .054934, .038520
114 1 , .12613 , .18313 , .10357 , .064106, .126130
115 2 , .012579, .013649, .018652, .025181, .012579
116 3 , .011890, .016142, .021105, .028908, .011890
117 4 , .013792, .026810, .052203, .066338, .013792 /
118 DATA (AT(1,IR),IR=1,3) /
119 S 0.298199E-02,-.394023E-03,0.319566E-04 /
120 DATA (BT(1,IR),IR=1,3) /
121 S-0.106432E-04,0.660324E-06,0.174356E-06 /
122 DATA (AT(2,IR),IR=1,3) /
123 S 0.143676E-01,0.366501E-02,-.160822E-02 /
124 DATA (BT(2,IR),IR=1,3) /
125 S-0.553979E-04,-.101701E-04,0.920868E-05 /
126 DATA (AT(3,IR),IR=1,3) /
127 S 0.197861E-01,0.315541E-02,-.174547E-02 /
128 DATA (BT(3,IR),IR=1,3) /
129 S-0.877012E-04,0.513302E-04,0.523138E-06 /
130 DATA (AT(4,IR),IR=1,3) /
131 S 0.289560E-01,-.208807E-02,-.121943E-02 /
132 DATA (BT(4,IR),IR=1,3) /
133 S-0.165960E-03,0.157704E-03,-.146427E-04 /
134 DATA (AT(5,IR),IR=1,3) /
135 S 0.103800E-01,0.436296E-02,-.161431E-02 /
136 DATA (BT(5,IR),IR=1,3) /
137 S -.276744E-04,-.327381E-04,0.127646E-04 /
138 DATA (AT(6,IR),IR=1,3) /
139 S 0.868859E-02,-.972752E-03,0.000000E-00 /
140 DATA (BT(6,IR),IR=1,3) /
141 S -.278412E-04,-.713940E-06,0.117469E-05 /
142 DATA (AT(7,IR),IR=1,3) /
143 S 0.250073E-03,0.455875E-03,0.109242E-03 /
144 DATA (BT(7,IR),IR=1,3) /
145 S 0.199846E-05,-.216313E-05,0.175991E-06 /
146 DATA (AT(8,IR),IR=1,3) /
147 S 0.307423E-01,0.110879E-02,-.322172E-03 /
148 DATA (BT(8,IR),IR=1,3) /
149 S-0.108482E-03,0.258096E-05,-.814575E-06 /
150 c
151 DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/
152 C-----------------------------------------------------------------------
153 c
154 IF (LEVOIGT) THEN
155 PVGCO2= 60.
156 PVGH2O= 30.
157 PVGO3 =400.
158 ELSE
159 PVGCO2= 0.
160 PVGH2O= 0.
161 PVGO3 = 0.
162 ENDIF
163 C
164 C
165 C* 2. PRESSURE OVER GAUSS SUB-LEVELS
166 C ------------------------------
167 C
168 200 CONTINUE
169 C
170 DO 201 JL = 1, KDLON
171 ZSSIG(JL, 1 ) = PPMB(JL,1) * 100.
172 201 CONTINUE
173 C
174 DO 206 JK = 1 , KFLEV
175 JKJ=(JK-1)*NG1P1+1
176 JKJR = JKJ
177 JKJP = JKJ + NG1P1
178 DO 203 JL = 1, KDLON
179 ZSSIG(JL,JKJP)=PPMB(JL,JK+1)* 100.
180 203 CONTINUE
181 DO 205 IG1=1,NG1
182 JKJ=JKJ+1
183 DO 204 JL = 1, KDLON
184 ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5
185 S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
186 204 CONTINUE
187 205 CONTINUE
188 206 CONTINUE
189 C
190 C-----------------------------------------------------------------------
191 C
192 C
193 C* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
194 C --------------------------------------------------
195 C
196 400 CONTINUE
197 C
198 DO 402 JKI=1,3*KFLEV
199 JKIP1=JKI+1
200 DO 401 JL = 1, KDLON
201 ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5
202 ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))
203 S /(10.*RG)
204 401 CONTINUE
205 402 CONTINUE
206 C
207 DO 406 JK = 1 , KFLEV
208 JKP1=JK+1
209 JKL = KFLEV+1 - JK
210 DO 403 JL = 1, KDLON
211 ZXWV(JL) = MAX (PWV(JL,JK) , ZEPSCQ )
212 ZXOZ(JL) = MAX (POZ(JL,JK) / PDP(JL,JK) , ZEPSCO )
213 403 CONTINUE
214 JKJ=(JK-1)*NG1P1+1
215 JKJPN=JKJ+NG1
216 DO 405 JKK=JKJ,JKJPN
217 DO 404 JL = 1, KDLON
218 ZDPM = ZABLY(JL,3,JKK)
219 ZUPM = ZABLY(JL,5,JKK) * ZDPM / 101325.
220 ZUPMCO2 = ( ZABLY(JL,5,JKK) + PVGCO2 ) * ZDPM / 101325.
221 ZUPMH2O = ( ZABLY(JL,5,JKK) + PVGH2O ) * ZDPM / 101325.
222 ZUPMO3 = ( ZABLY(JL,5,JKK) + PVGO3 ) * ZDPM / 101325.
223 ZDUC(JL,JKK) = ZDPM
224 ZABLY(JL,12,JKK) = ZXOZ(JL) * ZDPM
225 ZABLY(JL,13,JKK) = ZXOZ(JL) * ZUPMO3
226 ZU6 = ZXWV(JL) * ZUPM
227 ZFPPW = 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL))
228 ZABLY(JL,6,JKK) = ZXWV(JL) * ZUPMH2O
229 ZABLY(JL,11,JKK) = ZU6 * ZFPPW
230 ZABLY(JL,10,JKK) = ZU6 * (1.-ZFPPW)
231 ZABLY(JL,9,JKK) = RCO2 * ZUPMCO2
232 ZABLY(JL,8,JKK) = RCO2 * ZDPM
233 404 CONTINUE
234 405 CONTINUE
235 406 CONTINUE
236 C
237 C-----------------------------------------------------------------------
238 C
239 C
240 C* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
241 C --------------------------------------------------
242 C
243 500 CONTINUE
244 C
245 DO 502 JA = 1, NUA
246 DO 501 JL = 1, KDLON
247 PABCU(JL,JA,3*KFLEV+1) = 0.
248 501 CONTINUE
249 502 CONTINUE
250 C
251 DO 529 JK = 1 , KFLEV
252 JJ=(JK-1)*NG1P1+1
253 JJPN=JJ+NG1
254 JKL=KFLEV+1-JK
255 C
256 C
257 C* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
258 C --------------------------------------------------
259 C
260 510 CONTINUE
261 C
262 JAE1=3*KFLEV+1-JJ
263 JAE2=3*KFLEV+1-(JJ+1)
264 JAE3=3*KFLEV+1-JJPN
265 DO 512 JAE=1,5
266 DO 511 JL = 1, KDLON
267 ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL,JKL,1)
268 S +RAER(JAE,2)*PAER(JL,JKL,2)+RAER(JAE,3)*PAER(JL,JKL,3)
269 S +RAER(JAE,4)*PAER(JL,JKL,4)+RAER(JAE,5)*PAER(JL,JKL,5))
270 S /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3))
271 511 CONTINUE
272 512 CONTINUE
273 C
274 C
275 C
276 C* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
277 C --------------------------------------------------
278 C
279 520 CONTINUE
280 C
281 DO 521 JL = 1, KDLON
282 ZTAVI(JL)=PTAVE(JL,JKL)
283 ZTCON(JL)=EXP(6.08*(296./ZTAVI(JL)-1.))
284 ZTX=ZTAVI(JL)-TREF
285 ZTX2=ZTX*ZTX
286 ZZABLY = ZABLY(JL,6,JAE1)+ZABLY(JL,6,JAE2)+ZABLY(JL,6,JAE3)
287 CMAF ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.), 6.0)
288 ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.d+0), 6.d+0)
289 ZCAH1=AT(1,1)+ZUP*(AT(1,2)+ZUP*(AT(1,3)))
290 ZCBH1=BT(1,1)+ZUP*(BT(1,2)+ZUP*(BT(1,3)))
291 ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )
292 ZCAH2=AT(2,1)+ZUP*(AT(2,2)+ZUP*(AT(2,3)))
293 ZCBH2=BT(2,1)+ZUP*(BT(2,2)+ZUP*(BT(2,3)))
294 ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )
295 ZCAH3=AT(3,1)+ZUP*(AT(3,2)+ZUP*(AT(3,3)))
296 ZCBH3=BT(3,1)+ZUP*(BT(3,2)+ZUP*(BT(3,3)))
297 ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )
298 ZCAH4=AT(4,1)+ZUP*(AT(4,2)+ZUP*(AT(4,3)))
299 ZCBH4=BT(4,1)+ZUP*(BT(4,2)+ZUP*(BT(4,3)))
300 ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )
301 ZCAH5=AT(5,1)+ZUP*(AT(5,2)+ZUP*(AT(5,3)))
302 ZCBH5=BT(5,1)+ZUP*(BT(5,2)+ZUP*(BT(5,3)))
303 ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )
304 ZCAH6=AT(6,1)+ZUP*(AT(6,2)+ZUP*(AT(6,3)))
305 ZCBH6=BT(6,1)+ZUP*(BT(6,2)+ZUP*(BT(6,3)))
306 ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )
307 ZPHM6(JL)=EXP(-5.81E-4 * ZTX - 1.13E-6 * ZTX2 )
308 ZPSM6(JL)=EXP(-5.57E-4 * ZTX - 3.30E-6 * ZTX2 )
309 ZPHN6(JL)=EXP(-3.46E-5 * ZTX + 2.05E-7 * ZTX2 )
310 ZPSN6(JL)=EXP( 3.70E-3 * ZTX - 2.30E-6 * ZTX2 )
311 521 CONTINUE
312 C
313 DO 522 JL = 1, KDLON
314 ZTAVI(JL)=PTAVE(JL,JKL)
315 ZTX=ZTAVI(JL)-TREF
316 ZTX2=ZTX*ZTX
317 ZZABLY = ZABLY(JL,9,JAE1)+ZABLY(JL,9,JAE2)+ZABLY(JL,9,JAE3)
318 ZALUP = R10E * LOG ( ZZABLY )
319 CMAF ZUP = MAX( 0.0 , 5.0 + 0.5 * ZALUP )
320 ZUP = MAX( 0.d+0 , 5.0 + 0.5 * ZALUP )
321 ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP
322 ZCAC8=AT(8,1)+ZUP*(AT(8,2)+ZUP*(AT(8,3)))
323 ZCBC8=BT(8,1)+ZUP*(BT(8,2)+ZUP*(BT(8,3)))
324 ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )
325 ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2)
326 ZPSIO(JL) = EXP( 2.* (OCT(3)*ZTX+OCT(4)*ZTX2))
327 522 CONTINUE
328 C
329 DO 524 JKK=JJ,JJPN
330 JC=3*KFLEV+1-JKK
331 JCP1=JC+1
332 DO 523 JL = 1, KDLON
333 ZDIFF = PVIEW(JL)
334 PABCU(JL,10,JC)=PABCU(JL,10,JCP1)
335 S +ZABLY(JL,10,JC) *ZDIFF
336 PABCU(JL,11,JC)=PABCU(JL,11,JCP1)
337 S +ZABLY(JL,11,JC)*ZTCON(JL)*ZDIFF
338 C
339 PABCU(JL,12,JC)=PABCU(JL,12,JCP1)
340 S +ZABLY(JL,12,JC)*ZPHIO(JL)*ZDIFF
341 PABCU(JL,13,JC)=PABCU(JL,13,JCP1)
342 S +ZABLY(JL,13,JC)*ZPSIO(JL)*ZDIFF
343 C
344 PABCU(JL,7,JC)=PABCU(JL,7,JCP1)
345 S +ZABLY(JL,9,JC)*ZPSC2(JL)*ZDIFF
346 PABCU(JL,8,JC)=PABCU(JL,8,JCP1)
347 S +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF
348 PABCU(JL,9,JC)=PABCU(JL,9,JCP1)
349 S +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF
350 C
351 PABCU(JL,1,JC)=PABCU(JL,1,JCP1)
352 S +ZABLY(JL,6,JC)*ZPSH1(JL)*ZDIFF
353 PABCU(JL,2,JC)=PABCU(JL,2,JCP1)
354 S +ZABLY(JL,6,JC)*ZPSH2(JL)*ZDIFF
355 PABCU(JL,3,JC)=PABCU(JL,3,JCP1)
356 S +ZABLY(JL,6,JC)*ZPSH5(JL)*ZDIFF
357 PABCU(JL,4,JC)=PABCU(JL,4,JCP1)
358 S +ZABLY(JL,6,JC)*ZPSH3(JL)*ZDIFF
359 PABCU(JL,5,JC)=PABCU(JL,5,JCP1)
360 S +ZABLY(JL,6,JC)*ZPSH4(JL)*ZDIFF
361 PABCU(JL,6,JC)=PABCU(JL,6,JCP1)
362 S +ZABLY(JL,6,JC)*ZPSH6(JL)*ZDIFF
363 C
364 PABCU(JL,14,JC)=PABCU(JL,14,JCP1)
365 S +ZUAER(JL,1) *ZDUC(JL,JC)*ZDIFF
366 PABCU(JL,15,JC)=PABCU(JL,15,JCP1)
367 S +ZUAER(JL,2) *ZDUC(JL,JC)*ZDIFF
368 PABCU(JL,16,JC)=PABCU(JL,16,JCP1)
369 S +ZUAER(JL,3) *ZDUC(JL,JC)*ZDIFF
370 PABCU(JL,17,JC)=PABCU(JL,17,JCP1)
371 S +ZUAER(JL,4) *ZDUC(JL,JC)*ZDIFF
372 PABCU(JL,18,JC)=PABCU(JL,18,JCP1)
373 S +ZUAER(JL,5) *ZDUC(JL,JC)*ZDIFF
374 C
375 PABCU(JL,19,JC)=PABCU(JL,19,JCP1)
376 S +ZABLY(JL,8,JC)*RCH4/RCO2*ZPHM6(JL)*ZDIFF
377 PABCU(JL,20,JC)=PABCU(JL,20,JCP1)
378 S +ZABLY(JL,9,JC)*RCH4/RCO2*ZPSM6(JL)*ZDIFF
379 PABCU(JL,21,JC)=PABCU(JL,21,JCP1)
380 S +ZABLY(JL,8,JC)*RN2O/RCO2*ZPHN6(JL)*ZDIFF
381 PABCU(JL,22,JC)=PABCU(JL,22,JCP1)
382 S +ZABLY(JL,9,JC)*RN2O/RCO2*ZPSN6(JL)*ZDIFF
383 C
384 PABCU(JL,23,JC)=PABCU(JL,23,JCP1)
385 S +ZABLY(JL,8,JC)*RCFC11/RCO2 *ZDIFF
386 PABCU(JL,24,JC)=PABCU(JL,24,JCP1)
387 S +ZABLY(JL,8,JC)*RCFC12/RCO2 *ZDIFF
388 523 CONTINUE
389 524 CONTINUE
390 C
391 529 CONTINUE
392 C
393 C
394 RETURN
395 END

  ViewVC Help
Powered by ViewVC 1.1.21