/[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 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 3 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 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 guez 178 INTEGER jkl, jkk, jkjpn
72 guez 71 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 guez 178 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 guez 71
100 guez 178 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 guez 71
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