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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 24 - (hide annotations)
Wed Mar 3 13:23:49 2010 UTC (14 years, 2 months ago) by guez
Original Path: trunk/libf/phylmd/Radlwsw/lwu.f
File size: 12743 byte(s)
Created directory "phylmd/Radlwsw". Split "radlwsw.f" in files
containing a single procedure.

Removed variable "itaufinp1" in "leapfrog".

1 guez 24 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 YOMCST
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