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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 139 - (hide 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 guez 71 module LWU_m
2    
3     IMPLICIT none
4    
5     contains
6    
7 guez 139 SUBROUTINE LWU(PAER, PDP, PPMB, POZ, PTAVE, PVIEW, PWV, PABCU)
8 guez 71
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