1 |
! |
2 |
! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.4 2005/06/06 13:16:33 fairhead Exp $ |
3 |
! |
4 |
SUBROUTINE radlwsw(dist, rmu0, fract, |
5 |
. paprs, pplay,tsol,albedo, alblw, t,q,wo, |
6 |
. cldfra, cldemi, cldtaupd, |
7 |
. heat,heat0,cool,cool0,radsol,albpla, |
8 |
. topsw,toplw,solsw,sollw, |
9 |
. sollwdown, |
10 |
. topsw0,toplw0,solsw0,sollw0, |
11 |
. lwdn0, lwdn, lwup0, lwup, |
12 |
. swdn0, swdn, swup0, swup, |
13 |
. ok_ade, ok_aie, |
14 |
. tau_ae, piz_ae, cg_ae, |
15 |
. topswad, solswad, |
16 |
. cldtaupi, topswai, solswai) |
17 |
c |
18 |
use dimphy |
19 |
use clesphys |
20 |
use YOMCST |
21 |
use raddim, only: kflev, kdlon |
22 |
use yoethf |
23 |
IMPLICIT none |
24 |
c====================================================================== |
25 |
c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719 |
26 |
c Objet: interface entre le modele et les rayonnements |
27 |
c Arguments: |
28 |
c dist-----input-R- distance astronomique terre-soleil |
29 |
c rmu0-----input-R- cosinus de l'angle zenithal |
30 |
c fract----input-R- duree d'ensoleillement normalisee |
31 |
c co2_ppm--input-R- concentration du gaz carbonique (en ppm) |
32 |
c solaire--input-R- constante solaire (W/m**2) |
33 |
c paprs----input-R- pression a inter-couche (Pa) |
34 |
c pplay----input-R- pression au milieu de couche (Pa) |
35 |
c tsol-----input-R- temperature du sol (en K) |
36 |
c albedo---input-R- albedo du sol (entre 0 et 1) |
37 |
c t--------input-R- temperature (K) |
38 |
c q--------input-R- vapeur d'eau (en kg/kg) |
39 |
c wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505 |
40 |
c cldfra---input-R- fraction nuageuse (entre 0 et 1) |
41 |
c cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value) |
42 |
c cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1) |
43 |
c ok_ade---input-L- apply the Aerosol Direct Effect or not? |
44 |
c ok_aie---input-L- apply the Aerosol Indirect Effect or not? |
45 |
c tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F) |
46 |
c cldtaupi-input-R- epaisseur optique des nuages dans le visible |
47 |
c calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller |
48 |
c droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd |
49 |
c it is needed for the diagnostics of the aerosol indirect radiative forcing |
50 |
c |
51 |
c heat-----output-R- echauffement atmospherique (visible) (K/jour) |
52 |
c cool-----output-R- refroidissement dans l'IR (K/jour) |
53 |
c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas) |
54 |
c albpla---output-R- albedo planetaire (entre 0 et 1) |
55 |
c topsw----output-R- flux solaire net au sommet de l'atm. |
56 |
c toplw----output-R- ray. IR montant au sommet de l'atmosphere |
57 |
c solsw----output-R- flux solaire net a la surface |
58 |
c sollw----output-R- ray. IR montant a la surface |
59 |
c solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) |
60 |
c topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir) |
61 |
c solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind) |
62 |
c topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind) |
63 |
c |
64 |
c ATTENTION: swai and swad have to be interpreted in the following manner: |
65 |
c --------- |
66 |
c ok_ade=F & ok_aie=F -both are zero |
67 |
c ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad |
68 |
c indirect is zero |
69 |
c ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai |
70 |
c direct is zero |
71 |
c ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai |
72 |
c aerosol direct forcing is F_{AD} = topswai-topswad |
73 |
c |
74 |
|
75 |
c====================================================================== |
76 |
c |
77 |
real rmu0(klon), fract(klon), dist |
78 |
cIM real co2_ppm |
79 |
cIM real solaire |
80 |
c |
81 |
real, intent(in):: paprs(klon,klev+1) |
82 |
real pplay(klon,klev) |
83 |
real albedo(klon), alblw(klon), tsol(klon) |
84 |
real t(klon,klev), q(klon,klev) |
85 |
real, intent(in):: wo(klon,klev) |
86 |
real cldfra(klon,klev), cldemi(klon,klev), cldtaupd(klon,klev) |
87 |
real heat(klon,klev), cool(klon,klev) |
88 |
real heat0(klon,klev), cool0(klon,klev) |
89 |
real radsol(klon), topsw(klon), toplw(klon) |
90 |
real solsw(klon), sollw(klon), albpla(klon) |
91 |
real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon) |
92 |
real sollwdown(klon) |
93 |
cIM output 3D |
94 |
REAL*8 ZFSUP(KDLON,KFLEV+1) |
95 |
REAL*8 ZFSDN(KDLON,KFLEV+1) |
96 |
REAL*8 ZFSUP0(KDLON,KFLEV+1) |
97 |
REAL*8 ZFSDN0(KDLON,KFLEV+1) |
98 |
c |
99 |
REAL*8 ZFLUP(KDLON,KFLEV+1) |
100 |
REAL*8 ZFLDN(KDLON,KFLEV+1) |
101 |
REAL*8 ZFLUP0(KDLON,KFLEV+1) |
102 |
REAL*8 ZFLDN0(KDLON,KFLEV+1) |
103 |
c |
104 |
REAL*8 zx_alpha1, zx_alpha2 |
105 |
c |
106 |
c |
107 |
INTEGER k, kk, i, j, iof, nb_gr |
108 |
EXTERNAL lw, sw |
109 |
c |
110 |
cIM ctes ds clesphys.h REAL*8 RCO2, RCH4, RN2O, RCFC11, RCFC12 |
111 |
REAL*8 PSCT |
112 |
c |
113 |
REAL*8 PALBD(kdlon,2), PALBP(kdlon,2) |
114 |
REAL*8 PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) |
115 |
REAL*8 PPSOL(kdlon), PDP(kdlon,klev) |
116 |
REAL*8 PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) |
117 |
REAL*8 PTAVE(kdlon,kflev) |
118 |
REAL*8 PWV(kdlon,kflev), PQS(kdlon,kflev), POZON(kdlon,kflev) |
119 |
REAL*8 PAER(kdlon,kflev,5) |
120 |
REAL*8 PCLDLD(kdlon,kflev) |
121 |
REAL*8 PCLDLU(kdlon,kflev) |
122 |
REAL*8 PCLDSW(kdlon,kflev) |
123 |
REAL*8 PTAU(kdlon,2,kflev) |
124 |
REAL*8 POMEGA(kdlon,2,kflev) |
125 |
REAL*8 PCG(kdlon,2,kflev) |
126 |
c |
127 |
REAL*8 zfract(kdlon), zrmu0(kdlon), zdist |
128 |
c |
129 |
REAL*8 zheat(kdlon,kflev), zcool(kdlon,kflev) |
130 |
REAL*8 zheat0(kdlon,kflev), zcool0(kdlon,kflev) |
131 |
REAL*8 ztopsw(kdlon), ztoplw(kdlon) |
132 |
REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon) |
133 |
cIM |
134 |
REAL*8 zsollwdown(kdlon) |
135 |
c |
136 |
REAL*8 ztopsw0(kdlon), ztoplw0(kdlon) |
137 |
REAL*8 zsolsw0(kdlon), zsollw0(kdlon) |
138 |
REAL*8 zznormcp |
139 |
cIM output 3D : SWup, SWdn, LWup, LWdn |
140 |
REAL swdn(klon,kflev+1),swdn0(klon,kflev+1) |
141 |
REAL swup(klon,kflev+1),swup0(klon,kflev+1) |
142 |
REAL lwdn(klon,kflev+1),lwdn0(klon,kflev+1) |
143 |
REAL lwup(klon,kflev+1),lwup0(klon,kflev+1) |
144 |
c-OB |
145 |
cjq the following quantities are needed for the aerosol radiative forcings |
146 |
|
147 |
real topswad(klon), solswad(klon) ! output: aerosol direct forcing at TOA and surface |
148 |
real topswai(klon), solswai(klon) ! output: aerosol indirect forcing atTOA and surface |
149 |
real tau_ae(klon,klev,2), piz_ae(klon,klev,2), cg_ae(klon,klev,2) ! aerosol optical properties (see aeropt.F) |
150 |
real cldtaupi(klon,klev) ! cloud optical thickness for pre-industrial aerosol concentrations |
151 |
! (i.e., with a smaller droplet concentrationand thus larger droplet radii) |
152 |
logical ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not |
153 |
real*8 tauae(kdlon,kflev,2) ! aer opt properties |
154 |
real*8 pizae(kdlon,kflev,2) |
155 |
real*8 cgae(kdlon,kflev,2) |
156 |
REAL*8 PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use |
157 |
REAL*8 POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo |
158 |
REAL*8 ztopswad(kdlon), zsolswad(kdlon) ! Aerosol direct forcing at TOAand surface |
159 |
REAL*8 ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect |
160 |
cjq-end |
161 |
!rv |
162 |
tauae(:,:,:)=0. |
163 |
pizae(:,:,:)=0. |
164 |
cgae(:,:,:)=0. |
165 |
!rv |
166 |
|
167 |
c |
168 |
c------------------------------------------- |
169 |
nb_gr = klon / kdlon |
170 |
IF (nb_gr*kdlon .NE. klon) THEN |
171 |
PRINT*, "kdlon mauvais:", klon, kdlon, nb_gr |
172 |
stop 1 |
173 |
ENDIF |
174 |
IF (kflev .NE. klev) THEN |
175 |
PRINT*, "kflev differe de klev, kflev, klev" |
176 |
stop 1 |
177 |
ENDIF |
178 |
c------------------------------------------- |
179 |
DO k = 1, klev |
180 |
DO i = 1, klon |
181 |
heat(i,k)=0. |
182 |
cool(i,k)=0. |
183 |
heat0(i,k)=0. |
184 |
cool0(i,k)=0. |
185 |
ENDDO |
186 |
ENDDO |
187 |
c |
188 |
zdist = dist |
189 |
c |
190 |
cIM anciennes valeurs |
191 |
c RCO2 = co2_ppm * 1.0e-06 * 44.011/28.97 |
192 |
c |
193 |
cIM : on met RCO2, RCH4, RN2O, RCFC11 et RCFC12 dans clesphys.h /lecture ds conf_phys.F90 |
194 |
c RCH4 = 1.65E-06* 16.043/28.97 |
195 |
c RN2O = 306.E-09* 44.013/28.97 |
196 |
c RCFC11 = 280.E-12* 137.3686/28.97 |
197 |
c RCFC12 = 484.E-12* 120.9140/28.97 |
198 |
cIM anciennes valeurs |
199 |
c RCH4 = 1.72E-06* 16.043/28.97 |
200 |
c RN2O = 310.E-09* 44.013/28.97 |
201 |
c |
202 |
c PRINT*,'IMradlwsw : solaire, co2= ', solaire, co2_ppm |
203 |
PSCT = solaire/zdist/zdist |
204 |
c |
205 |
DO 99999 j = 1, nb_gr |
206 |
iof = kdlon*(j-1) |
207 |
c |
208 |
DO i = 1, kdlon |
209 |
zfract(i) = fract(iof+i) |
210 |
zrmu0(i) = rmu0(iof+i) |
211 |
PALBD(i,1) = albedo(iof+i) |
212 |
! PALBD(i,2) = albedo(iof+i) |
213 |
PALBD(i,2) = alblw(iof+i) |
214 |
PALBP(i,1) = albedo(iof+i) |
215 |
! PALBP(i,2) = albedo(iof+i) |
216 |
PALBP(i,2) = alblw(iof+i) |
217 |
cIM cf. JLD pour etre en accord avec ORCHIDEE il faut mettre PEMIS(i) = 0.96 |
218 |
PEMIS(i) = 1.0 |
219 |
PVIEW(i) = 1.66 |
220 |
PPSOL(i) = paprs(iof+i,1) |
221 |
zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2)) |
222 |
. / (pplay(iof+i,1)-pplay(iof+i,2)) |
223 |
zx_alpha2 = 1.0 - zx_alpha1 |
224 |
PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2 |
225 |
PTL(i,klev+1) = t(iof+i,klev) |
226 |
PDT0(i) = tsol(iof+i) - PTL(i,1) |
227 |
ENDDO |
228 |
DO k = 2, kflev |
229 |
DO i = 1, kdlon |
230 |
PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5 |
231 |
ENDDO |
232 |
ENDDO |
233 |
DO k = 1, kflev |
234 |
DO i = 1, kdlon |
235 |
PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1) |
236 |
PTAVE(i,k) = t(iof+i,k) |
237 |
PWV(i,k) = MAX (q(iof+i,k), 1.0e-12) |
238 |
PQS(i,k) = PWV(i,k) |
239 |
c wo: cm.atm (epaisseur en cm dans la situation standard) |
240 |
c POZON: kg/kg |
241 |
IF (bug_ozone) then |
242 |
POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968 |
243 |
. /(paprs(iof+i,k)-paprs(iof+i,k+1)) |
244 |
. *(paprs(iof+i,1)/101325.0) |
245 |
ELSE |
246 |
c le calcul qui suit est maintenant fait dans ozonecm (MPL) |
247 |
POZON(i,k) = wo(i,k) |
248 |
ENDIF |
249 |
PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) |
250 |
PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) |
251 |
PCLDSW(i,k) = cldfra(iof+i,k) |
252 |
PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable |
253 |
PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines |
254 |
POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k)) |
255 |
POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k)) |
256 |
PCG(i,1,k) = 0.865 |
257 |
PCG(i,2,k) = 0.910 |
258 |
c-OB |
259 |
cjq Introduced for aerosol indirect forcings. |
260 |
cjq The following values use the cloud optical thickness calculated from |
261 |
cjq present-day aerosol concentrations whereas the quantities without the |
262 |
cjq "A" at the end are for pre-industial (natural-only) aerosol concentrations |
263 |
cjq |
264 |
PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable |
265 |
PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines |
266 |
POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k)) |
267 |
POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k)) |
268 |
cjq-end |
269 |
ENDDO |
270 |
ENDDO |
271 |
c |
272 |
DO k = 1, kflev+1 |
273 |
DO i = 1, kdlon |
274 |
PPMB(i,k) = paprs(iof+i,k)/100.0 |
275 |
ENDDO |
276 |
ENDDO |
277 |
c |
278 |
DO kk = 1, 5 |
279 |
DO k = 1, kflev |
280 |
DO i = 1, kdlon |
281 |
PAER(i,k,kk) = 1.0E-15 |
282 |
ENDDO |
283 |
ENDDO |
284 |
ENDDO |
285 |
c-OB |
286 |
DO k = 1, kflev |
287 |
DO i = 1, kdlon |
288 |
tauae(i,k,1)=tau_ae(iof+i,k,1) |
289 |
pizae(i,k,1)=piz_ae(iof+i,k,1) |
290 |
cgae(i,k,1) =cg_ae(iof+i,k,1) |
291 |
tauae(i,k,2)=tau_ae(iof+i,k,2) |
292 |
pizae(i,k,2)=piz_ae(iof+i,k,2) |
293 |
cgae(i,k,2) =cg_ae(iof+i,k,2) |
294 |
ENDDO |
295 |
ENDDO |
296 |
c |
297 |
c====================================================================== |
298 |
cIM ctes ds clesphys.h CALL LW(RCO2,RCH4,RN2O,RCFC11,RCFC12, |
299 |
CALL LW( |
300 |
. PPMB, PDP, |
301 |
. PPSOL,PDT0,PEMIS, |
302 |
. PTL, PTAVE, PWV, POZON, PAER, |
303 |
. PCLDLD,PCLDLU, |
304 |
. PVIEW, |
305 |
. zcool, zcool0, |
306 |
. ztoplw,zsollw,ztoplw0,zsollw0, |
307 |
. zsollwdown, |
308 |
. ZFLUP, ZFLDN, ZFLUP0,ZFLDN0) |
309 |
cIM ctes ds clesphys.h CALL SW(PSCT, RCO2, zrmu0, zfract, |
310 |
CALL SW(PSCT, zrmu0, zfract, |
311 |
S PPMB, PDP, |
312 |
S PPSOL, PALBD, PALBP, |
313 |
S PTAVE, PWV, PQS, POZON, PAER, |
314 |
S PCLDSW, PTAU, POMEGA, PCG, |
315 |
S zheat, zheat0, |
316 |
S zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0, |
317 |
S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, |
318 |
S tauae, pizae, cgae, ! aerosol optical properties |
319 |
s PTAUA, POMEGAA, |
320 |
s ztopswad,zsolswad,ztopswai,zsolswai, ! diagnosed aerosol forcing |
321 |
J ok_ade, ok_aie) ! apply aerosol effects or not? |
322 |
|
323 |
c====================================================================== |
324 |
DO i = 1, kdlon |
325 |
radsol(iof+i) = zsolsw(i) + zsollw(i) |
326 |
topsw(iof+i) = ztopsw(i) |
327 |
toplw(iof+i) = ztoplw(i) |
328 |
solsw(iof+i) = zsolsw(i) |
329 |
sollw(iof+i) = zsollw(i) |
330 |
sollwdown(iof+i) = zsollwdown(i) |
331 |
cIM |
332 |
DO k = 1, kflev+1 |
333 |
lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) |
334 |
lwdn ( iof+i,k) = ZFLDN ( i,k) |
335 |
lwup0 ( iof+i,k) = ZFLUP0 ( i,k) |
336 |
lwup ( iof+i,k) = ZFLUP ( i,k) |
337 |
ENDDO |
338 |
c |
339 |
topsw0(iof+i) = ztopsw0(i) |
340 |
toplw0(iof+i) = ztoplw0(i) |
341 |
solsw0(iof+i) = zsolsw0(i) |
342 |
sollw0(iof+i) = zsollw0(i) |
343 |
albpla(iof+i) = zalbpla(i) |
344 |
cIM |
345 |
DO k = 1, kflev+1 |
346 |
swdn0 ( iof+i,k) = ZFSDN0 ( i,k) |
347 |
swdn ( iof+i,k) = ZFSDN ( i,k) |
348 |
swup0 ( iof+i,k) = ZFSUP0 ( i,k) |
349 |
swup ( iof+i,k) = ZFSUP ( i,k) |
350 |
ENDDO !k=1, kflev+1 |
351 |
ENDDO |
352 |
cjq-transform the aerosol forcings, if they have |
353 |
cjq to be calculated |
354 |
IF (ok_ade) THEN |
355 |
DO i = 1, kdlon |
356 |
topswad(iof+i) = ztopswad(i) |
357 |
solswad(iof+i) = zsolswad(i) |
358 |
ENDDO |
359 |
ELSE |
360 |
DO i = 1, kdlon |
361 |
topswad(iof+i) = 0.0 |
362 |
solswad(iof+i) = 0.0 |
363 |
ENDDO |
364 |
ENDIF |
365 |
IF (ok_aie) THEN |
366 |
DO i = 1, kdlon |
367 |
topswai(iof+i) = ztopswai(i) |
368 |
solswai(iof+i) = zsolswai(i) |
369 |
ENDDO |
370 |
ELSE |
371 |
DO i = 1, kdlon |
372 |
topswai(iof+i) = 0.0 |
373 |
solswai(iof+i) = 0.0 |
374 |
ENDDO |
375 |
ENDIF |
376 |
cjq-end |
377 |
DO k = 1, kflev |
378 |
c DO i = 1, kdlon |
379 |
c heat(iof+i,k) = zheat(i,k) |
380 |
c cool(iof+i,k) = zcool(i,k) |
381 |
c heat0(iof+i,k) = zheat0(i,k) |
382 |
c cool0(iof+i,k) = zcool0(i,k) |
383 |
c ENDDO |
384 |
DO i = 1, kdlon |
385 |
C scale factor to take into account the difference between |
386 |
C dry air and watter vapour scpecific heat capacity |
387 |
zznormcp=1.0+RVTMP2*PWV(i,k) |
388 |
heat(iof+i,k) = zheat(i,k)/zznormcp |
389 |
cool(iof+i,k) = zcool(i,k)/zznormcp |
390 |
heat0(iof+i,k) = zheat0(i,k)/zznormcp |
391 |
cool0(iof+i,k) = zcool0(i,k)/zznormcp |
392 |
ENDDO |
393 |
ENDDO |
394 |
c |
395 |
99999 CONTINUE |
396 |
RETURN |
397 |
END |
398 |
cIM ctes ds clesphys.h SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC, |
399 |
SUBROUTINE SW(PSCT, PRMU0, PFRAC, |
400 |
S PPMB, PDP, |
401 |
S PPSOL, PALBD, PALBP, |
402 |
S PTAVE, PWV, PQS, POZON, PAER, |
403 |
S PCLDSW, PTAU, POMEGA, PCG, |
404 |
S PHEAT, PHEAT0, |
405 |
S PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0, |
406 |
S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, |
407 |
S tauae, pizae, cgae, |
408 |
s PTAUA, POMEGAA, |
409 |
S PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI, |
410 |
J ok_ade, ok_aie ) |
411 |
|
412 |
use dimens_m |
413 |
use dimphy |
414 |
use clesphys |
415 |
use YOMCST |
416 |
use raddim |
417 |
IMPLICIT none |
418 |
|
419 |
C |
420 |
C ------------------------------------------------------------------ |
421 |
C |
422 |
C PURPOSE. |
423 |
C -------- |
424 |
C |
425 |
C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO |
426 |
C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
427 |
C |
428 |
C METHOD. |
429 |
C ------- |
430 |
C |
431 |
C 1. COMPUTES ABSORBER AMOUNTS (SWU) |
432 |
C 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S) |
433 |
C 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S) |
434 |
C |
435 |
C REFERENCE. |
436 |
C ---------- |
437 |
C |
438 |
C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
439 |
C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
440 |
C |
441 |
C AUTHOR. |
442 |
C ------- |
443 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
444 |
C |
445 |
C MODIFICATIONS. |
446 |
C -------------- |
447 |
C ORIGINAL : 89-07-14 |
448 |
C 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo |
449 |
c 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER) |
450 |
C ------------------------------------------------------------------ |
451 |
C |
452 |
C* ARGUMENTS: |
453 |
C |
454 |
REAL*8 PSCT ! constante solaire (valeur conseillee: 1370) |
455 |
cIM ctes ds clesphys.h REAL*8 RCO2 ! concentration CO2 (IPCC: 353.E-06*44.011/28.97) |
456 |
C |
457 |
REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (PA) |
458 |
REAL*8 PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA) |
459 |
REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB) |
460 |
C |
461 |
REAL*8 PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE |
462 |
REAL*8 PFRAC(KDLON) ! fraction de la journee |
463 |
C |
464 |
REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K) |
465 |
REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (KG/KG) |
466 |
REAL*8 PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG) |
467 |
REAL*8 POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG) |
468 |
REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS |
469 |
C |
470 |
REAL*8 PALBD(KDLON,2) ! albedo du sol (lumiere diffuse) |
471 |
REAL*8 PALBP(KDLON,2) ! albedo du sol (lumiere parallele) |
472 |
C |
473 |
REAL*8 PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION |
474 |
REAL*8 PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS |
475 |
REAL*8 PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR |
476 |
REAL*8 POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO |
477 |
C |
478 |
REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY) |
479 |
REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky |
480 |
REAL*8 PALBPLA(KDLON) ! PLANETARY ALBEDO |
481 |
REAL*8 PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A. |
482 |
REAL*8 PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE |
483 |
REAL*8 PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY) |
484 |
REAL*8 PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY) |
485 |
C |
486 |
C* LOCAL VARIABLES: |
487 |
C |
488 |
REAL*8 ZOZ(KDLON,KFLEV) |
489 |
REAL*8 ZAKI(KDLON,2) |
490 |
REAL*8 ZCLD(KDLON,KFLEV) |
491 |
REAL*8 ZCLEAR(KDLON) |
492 |
REAL*8 ZDSIG(KDLON,KFLEV) |
493 |
REAL*8 ZFACT(KDLON) |
494 |
REAL*8 ZFD(KDLON,KFLEV+1) |
495 |
REAL*8 ZFDOWN(KDLON,KFLEV+1) |
496 |
REAL*8 ZFU(KDLON,KFLEV+1) |
497 |
REAL*8 ZFUP(KDLON,KFLEV+1) |
498 |
REAL*8 ZRMU(KDLON) |
499 |
REAL*8 ZSEC(KDLON) |
500 |
REAL*8 ZUD(KDLON,5,KFLEV+1) |
501 |
REAL*8 ZCLDSW0(KDLON,KFLEV) |
502 |
c |
503 |
REAL*8 ZFSUP(KDLON,KFLEV+1) |
504 |
REAL*8 ZFSDN(KDLON,KFLEV+1) |
505 |
REAL*8 ZFSUP0(KDLON,KFLEV+1) |
506 |
REAL*8 ZFSDN0(KDLON,KFLEV+1) |
507 |
C |
508 |
INTEGER inu, jl, jk, i, k, kpl1 |
509 |
c |
510 |
INTEGER swpas ! Every swpas steps, sw is calculated |
511 |
PARAMETER(swpas=1) |
512 |
c |
513 |
INTEGER itapsw |
514 |
LOGICAL appel1er |
515 |
DATA itapsw /0/ |
516 |
DATA appel1er /.TRUE./ |
517 |
cjq-Introduced for aerosol forcings |
518 |
real*8 flag_aer |
519 |
logical ok_ade, ok_aie ! use aerosol forcings or not? |
520 |
real*8 tauae(kdlon,kflev,2) ! aerosol optical properties |
521 |
real*8 pizae(kdlon,kflev,2) ! (see aeropt.F) |
522 |
real*8 cgae(kdlon,kflev,2) ! -"- |
523 |
REAL*8 PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value) |
524 |
REAL*8 POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO |
525 |
REAL*8 PTOPSWAD(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR) |
526 |
REAL*8 PSOLSWAD(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR) |
527 |
REAL*8 PTOPSWAI(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND) |
528 |
REAL*8 PSOLSWAI(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND) |
529 |
cjq - Fluxes including aerosol effects |
530 |
REAL*8 ZFSUPAD(KDLON,KFLEV+1) |
531 |
REAL*8 ZFSDNAD(KDLON,KFLEV+1) |
532 |
REAL*8 ZFSUPAI(KDLON,KFLEV+1) |
533 |
REAL*8 ZFSDNAI(KDLON,KFLEV+1) |
534 |
logical initialized |
535 |
SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes |
536 |
!rv |
537 |
save flag_aer |
538 |
data initialized/.false./ |
539 |
cjq-end |
540 |
if(.not.initialized) then |
541 |
flag_aer=0. |
542 |
initialized=.TRUE. |
543 |
endif |
544 |
!rv |
545 |
|
546 |
c |
547 |
IF (appel1er) THEN |
548 |
PRINT*, 'SW calling frequency : ', swpas |
549 |
PRINT*, " In general, it should be 1" |
550 |
appel1er = .FALSE. |
551 |
ENDIF |
552 |
C ------------------------------------------------------------------ |
553 |
IF (MOD(itapsw,swpas).EQ.0) THEN |
554 |
c |
555 |
DO JK = 1 , KFLEV |
556 |
DO JL = 1, KDLON |
557 |
ZCLDSW0(JL,JK) = 0.0 |
558 |
IF (bug_ozone) then |
559 |
ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG |
560 |
. *PDP(JL,JK)*(101325.0/PPSOL(JL)) |
561 |
ELSE |
562 |
c Correction MPL 100505 |
563 |
ZOZ(JL,JK) = POZON(JL,JK)*RMD/RMO3*46.6968/RG*PDP(JL,JK) |
564 |
ENDIF |
565 |
ENDDO |
566 |
ENDDO |
567 |
C |
568 |
C |
569 |
c clear-sky: |
570 |
cIM ctes ds clesphys.h CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL, |
571 |
CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL, |
572 |
S PRMU0,PFRAC,PTAVE,PWV, |
573 |
S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
574 |
INU = 1 |
575 |
CALL SW1S(INU, |
576 |
S PAER, flag_aer, tauae, pizae, cgae, |
577 |
S PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, |
578 |
S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
579 |
S ZFD, ZFU) |
580 |
INU = 2 |
581 |
CALL SW2S(INU, |
582 |
S PAER, flag_aer, tauae, pizae, cgae, |
583 |
S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, |
584 |
S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
585 |
S PWV, PQS, |
586 |
S ZFDOWN, ZFUP) |
587 |
DO JK = 1 , KFLEV+1 |
588 |
DO JL = 1, KDLON |
589 |
ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
590 |
ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
591 |
ENDDO |
592 |
ENDDO |
593 |
|
594 |
flag_aer=0.0 |
595 |
CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, |
596 |
S PRMU0,PFRAC,PTAVE,PWV, |
597 |
S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
598 |
INU = 1 |
599 |
CALL SW1S(INU, |
600 |
S PAER, flag_aer, tauae, pizae, cgae, |
601 |
S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
602 |
S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
603 |
S ZFD, ZFU) |
604 |
INU = 2 |
605 |
CALL SW2S(INU, |
606 |
S PAER, flag_aer, tauae, pizae, cgae, |
607 |
S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
608 |
S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
609 |
S PWV, PQS, |
610 |
S ZFDOWN, ZFUP) |
611 |
|
612 |
c cloudy-sky: |
613 |
|
614 |
DO JK = 1 , KFLEV+1 |
615 |
DO JL = 1, KDLON |
616 |
ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
617 |
ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
618 |
ENDDO |
619 |
ENDDO |
620 |
|
621 |
c |
622 |
IF (ok_ade) THEN |
623 |
c |
624 |
c cloudy-sky + aerosol dir OB |
625 |
flag_aer=1.0 |
626 |
CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, |
627 |
S PRMU0,PFRAC,PTAVE,PWV, |
628 |
S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
629 |
INU = 1 |
630 |
CALL SW1S(INU, |
631 |
S PAER, flag_aer, tauae, pizae, cgae, |
632 |
S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
633 |
S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
634 |
S ZFD, ZFU) |
635 |
INU = 2 |
636 |
CALL SW2S(INU, |
637 |
S PAER, flag_aer, tauae, pizae, cgae, |
638 |
S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
639 |
S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
640 |
S PWV, PQS, |
641 |
S ZFDOWN, ZFUP) |
642 |
DO JK = 1 , KFLEV+1 |
643 |
DO JL = 1, KDLON |
644 |
ZFSUPAD(JL,JK) = ZFSUP(JL,JK) |
645 |
ZFSDNAD(JL,JK) = ZFSDN(JL,JK) |
646 |
ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
647 |
ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
648 |
ENDDO |
649 |
ENDDO |
650 |
|
651 |
ENDIF ! ok_ade |
652 |
|
653 |
IF (ok_aie) THEN |
654 |
|
655 |
cjq cloudy-sky + aerosol direct + aerosol indirect |
656 |
flag_aer=1.0 |
657 |
CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, |
658 |
S PRMU0,PFRAC,PTAVE,PWV, |
659 |
S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
660 |
INU = 1 |
661 |
CALL SW1S(INU, |
662 |
S PAER, flag_aer, tauae, pizae, cgae, |
663 |
S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
664 |
S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, |
665 |
S ZFD, ZFU) |
666 |
INU = 2 |
667 |
CALL SW2S(INU, |
668 |
S PAER, flag_aer, tauae, pizae, cgae, |
669 |
S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
670 |
S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, |
671 |
S PWV, PQS, |
672 |
S ZFDOWN, ZFUP) |
673 |
DO JK = 1 , KFLEV+1 |
674 |
DO JL = 1, KDLON |
675 |
ZFSUPAI(JL,JK) = ZFSUP(JL,JK) |
676 |
ZFSDNAI(JL,JK) = ZFSDN(JL,JK) |
677 |
ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
678 |
ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
679 |
ENDDO |
680 |
ENDDO |
681 |
ENDIF ! ok_aie |
682 |
cjq -end |
683 |
|
684 |
itapsw = 0 |
685 |
ENDIF |
686 |
itapsw = itapsw + 1 |
687 |
C |
688 |
DO k = 1, KFLEV |
689 |
kpl1 = k+1 |
690 |
DO i = 1, KDLON |
691 |
PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) |
692 |
. -(ZFSDN(i,k)-ZFSDN(i,kpl1)) |
693 |
PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k) |
694 |
PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k)) |
695 |
. -(ZFSDN0(i,k)-ZFSDN0(i,kpl1)) |
696 |
PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k) |
697 |
ENDDO |
698 |
ENDDO |
699 |
DO i = 1, KDLON |
700 |
PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20) |
701 |
c |
702 |
PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1) |
703 |
PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1) |
704 |
c |
705 |
PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1) |
706 |
PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1) |
707 |
c-OB |
708 |
PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1) |
709 |
PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1) |
710 |
c |
711 |
PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1) |
712 |
PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1) |
713 |
c-fin |
714 |
ENDDO |
715 |
C |
716 |
RETURN |
717 |
END |
718 |
c |
719 |
cIM ctes ds clesphys.h SUBROUTINE SWU (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC, |
720 |
SUBROUTINE SWU (PSCT,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC, |
721 |
S PTAVE,PWV,PAKI,PCLD,PCLEAR,PDSIG,PFACT, |
722 |
S PRMU,PSEC,PUD) |
723 |
use dimens_m |
724 |
use dimphy |
725 |
use clesphys |
726 |
use YOMCST |
727 |
use raddim |
728 |
use radepsi |
729 |
use radopt |
730 |
IMPLICIT none |
731 |
C |
732 |
C* ARGUMENTS: |
733 |
C |
734 |
REAL*8 PSCT |
735 |
cIM ctes ds clesphys.h REAL*8 RCO2 |
736 |
REAL*8 PCLDSW(KDLON,KFLEV) |
737 |
REAL*8 PPMB(KDLON,KFLEV+1) |
738 |
REAL*8 PPSOL(KDLON) |
739 |
REAL*8 PRMU0(KDLON) |
740 |
REAL*8 PFRAC(KDLON) |
741 |
REAL*8 PTAVE(KDLON,KFLEV) |
742 |
REAL*8 PWV(KDLON,KFLEV) |
743 |
C |
744 |
REAL*8 PAKI(KDLON,2) |
745 |
REAL*8 PCLD(KDLON,KFLEV) |
746 |
REAL*8 PCLEAR(KDLON) |
747 |
REAL*8 PDSIG(KDLON,KFLEV) |
748 |
REAL*8 PFACT(KDLON) |
749 |
REAL*8 PRMU(KDLON) |
750 |
REAL*8 PSEC(KDLON) |
751 |
REAL*8 PUD(KDLON,5,KFLEV+1) |
752 |
C |
753 |
C* LOCAL VARIABLES: |
754 |
C |
755 |
INTEGER IIND(2) |
756 |
REAL*8 ZC1J(KDLON,KFLEV+1) |
757 |
REAL*8 ZCLEAR(KDLON) |
758 |
REAL*8 ZCLOUD(KDLON) |
759 |
REAL*8 ZN175(KDLON) |
760 |
REAL*8 ZN190(KDLON) |
761 |
REAL*8 ZO175(KDLON) |
762 |
REAL*8 ZO190(KDLON) |
763 |
REAL*8 ZSIGN(KDLON) |
764 |
REAL*8 ZR(KDLON,2) |
765 |
REAL*8 ZSIGO(KDLON) |
766 |
REAL*8 ZUD(KDLON,2) |
767 |
REAL*8 ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW |
768 |
INTEGER jl, jk, jkp1, jkl, jklp1, ja |
769 |
C |
770 |
C* Prescribed Data: |
771 |
c |
772 |
REAL*8 ZPDH2O,ZPDUMG |
773 |
SAVE ZPDH2O,ZPDUMG |
774 |
REAL*8 ZPRH2O,ZPRUMG |
775 |
SAVE ZPRH2O,ZPRUMG |
776 |
REAL*8 RTDH2O,RTDUMG |
777 |
SAVE RTDH2O,RTDUMG |
778 |
REAL*8 RTH2O ,RTUMG |
779 |
SAVE RTH2O ,RTUMG |
780 |
DATA ZPDH2O,ZPDUMG / 0.8 , 0.75 / |
781 |
DATA ZPRH2O,ZPRUMG / 30000., 30000. / |
782 |
DATA RTDH2O,RTDUMG / 0.40 , 0.375 / |
783 |
DATA RTH2O ,RTUMG / 240. , 240. / |
784 |
C ------------------------------------------------------------------ |
785 |
C |
786 |
C* 1. COMPUTES AMOUNTS OF ABSORBERS |
787 |
C ----------------------------- |
788 |
C |
789 |
100 CONTINUE |
790 |
C |
791 |
IIND(1)=1 |
792 |
IIND(2)=2 |
793 |
C |
794 |
C |
795 |
C* 1.1 INITIALIZES QUANTITIES |
796 |
C ---------------------- |
797 |
C |
798 |
110 CONTINUE |
799 |
C |
800 |
DO 111 JL = 1, KDLON |
801 |
PUD(JL,1,KFLEV+1)=0. |
802 |
PUD(JL,2,KFLEV+1)=0. |
803 |
PUD(JL,3,KFLEV+1)=0. |
804 |
PUD(JL,4,KFLEV+1)=0. |
805 |
PUD(JL,5,KFLEV+1)=0. |
806 |
PFACT(JL)= PRMU0(JL) * PFRAC(JL) * PSCT |
807 |
PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. |
808 |
PSEC(JL)=1./PRMU(JL) |
809 |
ZC1J(JL,KFLEV+1)=0. |
810 |
111 CONTINUE |
811 |
C |
812 |
C* 1.3 AMOUNTS OF ABSORBERS |
813 |
C -------------------- |
814 |
C |
815 |
130 CONTINUE |
816 |
C |
817 |
DO 131 JL= 1, KDLON |
818 |
ZUD(JL,1) = 0. |
819 |
ZUD(JL,2) = 0. |
820 |
ZO175(JL) = PPSOL(JL)** (ZPDUMG+1.) |
821 |
ZO190(JL) = PPSOL(JL)** (ZPDH2O+1.) |
822 |
ZSIGO(JL) = PPSOL(JL) |
823 |
ZCLEAR(JL)=1. |
824 |
ZCLOUD(JL)=0. |
825 |
131 CONTINUE |
826 |
C |
827 |
DO 133 JK = 1 , KFLEV |
828 |
JKP1 = JK + 1 |
829 |
JKL = KFLEV+1 - JK |
830 |
JKLP1 = JKL+1 |
831 |
DO 132 JL = 1, KDLON |
832 |
ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O |
833 |
ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG |
834 |
ZWH2O = MAX (PWV(JL,JK) , ZEPSCQ ) |
835 |
ZSIGN(JL) = 100. * PPMB(JL,JKP1) |
836 |
PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL) |
837 |
ZN175(JL) = ZSIGN(JL) ** (ZPDUMG+1.) |
838 |
ZN190(JL) = ZSIGN(JL) ** (ZPDH2O+1.) |
839 |
ZDSCO2 = ZO175(JL) - ZN175(JL) |
840 |
ZDSH2O = ZO190(JL) - ZN190(JL) |
841 |
PUD(JL,1,JK) = 1./( 10.* RG * (ZPDH2O+1.) )/(ZPRH2O**ZPDH2O) |
842 |
. * ZDSH2O * ZWH2O * ZRTH |
843 |
PUD(JL,2,JK) = 1./( 10.* RG * (ZPDUMG+1.) )/(ZPRUMG**ZPDUMG) |
844 |
. * ZDSCO2 * RCO2 * ZRTU |
845 |
ZFPPW=1.6078*ZWH2O/(1.+0.608*ZWH2O) |
846 |
PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW |
847 |
PUD(JL,5,JK)=PUD(JL,1,JK)*(1.-ZFPPW) |
848 |
ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK) |
849 |
ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK) |
850 |
ZSIGO(JL) = ZSIGN(JL) |
851 |
ZO175(JL) = ZN175(JL) |
852 |
ZO190(JL) = ZN190(JL) |
853 |
C |
854 |
IF (NOVLP.EQ.1) THEN |
855 |
ZCLEAR(JL)=ZCLEAR(JL) |
856 |
S *(1.-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) |
857 |
S /(1.-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
858 |
ZC1J(JL,JKL)= 1.0 - ZCLEAR(JL) |
859 |
ZCLOUD(JL) = PCLDSW(JL,JKL) |
860 |
ELSE IF (NOVLP.EQ.2) THEN |
861 |
ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL)) |
862 |
ZC1J(JL,JKL) = ZCLOUD(JL) |
863 |
ELSE IF (NOVLP.EQ.3) THEN |
864 |
ZCLEAR(JL) = ZCLEAR(JL)*(1.-PCLDSW(JL,JKL)) |
865 |
ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
866 |
ZC1J(JL,JKL) = ZCLOUD(JL) |
867 |
END IF |
868 |
132 CONTINUE |
869 |
133 CONTINUE |
870 |
DO 134 JL=1, KDLON |
871 |
PCLEAR(JL)=1.-ZC1J(JL,1) |
872 |
134 CONTINUE |
873 |
DO 136 JK=1,KFLEV |
874 |
DO 135 JL=1, KDLON |
875 |
IF (PCLEAR(JL).LT.1.) THEN |
876 |
PCLD(JL,JK)=PCLDSW(JL,JK)/(1.-PCLEAR(JL)) |
877 |
ELSE |
878 |
PCLD(JL,JK)=0. |
879 |
END IF |
880 |
135 CONTINUE |
881 |
136 CONTINUE |
882 |
C |
883 |
C |
884 |
C* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS |
885 |
C ----------------------------------------------- |
886 |
C |
887 |
140 CONTINUE |
888 |
C |
889 |
DO 142 JA = 1,2 |
890 |
DO 141 JL = 1, KDLON |
891 |
ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL) |
892 |
141 CONTINUE |
893 |
142 CONTINUE |
894 |
C |
895 |
CALL SWTT1(2, 2, IIND, ZUD, ZR) |
896 |
C |
897 |
DO 144 JA = 1,2 |
898 |
DO 143 JL = 1, KDLON |
899 |
PAKI(JL,JA) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA) |
900 |
143 CONTINUE |
901 |
144 CONTINUE |
902 |
C |
903 |
C |
904 |
C ------------------------------------------------------------------ |
905 |
C |
906 |
RETURN |
907 |
END |
908 |
SUBROUTINE SW1S ( KNU |
909 |
S , PAER , flag_aer, tauae, pizae, cgae |
910 |
S , PALBD , PALBP, PCG , PCLD , PCLEAR, PCLDSW |
911 |
S , PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD |
912 |
S , PFD , PFU) |
913 |
use dimens_m |
914 |
use dimphy |
915 |
use raddim |
916 |
IMPLICIT none |
917 |
C |
918 |
C ------------------------------------------------------------------ |
919 |
C PURPOSE. |
920 |
C -------- |
921 |
C |
922 |
C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO |
923 |
C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
924 |
C |
925 |
C METHOD. |
926 |
C ------- |
927 |
C |
928 |
C 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO |
929 |
C CONTINUUM SCATTERING |
930 |
C 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION |
931 |
C |
932 |
C REFERENCE. |
933 |
C ---------- |
934 |
C |
935 |
C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
936 |
C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
937 |
C |
938 |
C AUTHOR. |
939 |
C ------- |
940 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
941 |
C |
942 |
C MODIFICATIONS. |
943 |
C -------------- |
944 |
C ORIGINAL : 89-07-14 |
945 |
C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO |
946 |
C ------------------------------------------------------------------ |
947 |
C |
948 |
C* ARGUMENTS: |
949 |
C |
950 |
INTEGER KNU |
951 |
c-OB |
952 |
real*8 flag_aer |
953 |
real*8 tauae(kdlon,kflev,2) |
954 |
real*8 pizae(kdlon,kflev,2) |
955 |
real*8 cgae(kdlon,kflev,2) |
956 |
REAL*8 PAER(KDLON,KFLEV,5) |
957 |
REAL*8 PALBD(KDLON,2) |
958 |
REAL*8 PALBP(KDLON,2) |
959 |
REAL*8 PCG(KDLON,2,KFLEV) |
960 |
REAL*8 PCLD(KDLON,KFLEV) |
961 |
REAL*8 PCLDSW(KDLON,KFLEV) |
962 |
REAL*8 PCLEAR(KDLON) |
963 |
REAL*8 PDSIG(KDLON,KFLEV) |
964 |
REAL*8 POMEGA(KDLON,2,KFLEV) |
965 |
REAL*8 POZ(KDLON,KFLEV) |
966 |
REAL*8 PRMU(KDLON) |
967 |
REAL*8 PSEC(KDLON) |
968 |
REAL*8 PTAU(KDLON,2,KFLEV) |
969 |
REAL*8 PUD(KDLON,5,KFLEV+1) |
970 |
C |
971 |
REAL*8 PFD(KDLON,KFLEV+1) |
972 |
REAL*8 PFU(KDLON,KFLEV+1) |
973 |
C |
974 |
C* LOCAL VARIABLES: |
975 |
C |
976 |
INTEGER IIND(4) |
977 |
C |
978 |
REAL*8 ZCGAZ(KDLON,KFLEV) |
979 |
REAL*8 ZDIFF(KDLON) |
980 |
REAL*8 ZDIRF(KDLON) |
981 |
REAL*8 ZPIZAZ(KDLON,KFLEV) |
982 |
REAL*8 ZRAYL(KDLON) |
983 |
REAL*8 ZRAY1(KDLON,KFLEV+1) |
984 |
REAL*8 ZRAY2(KDLON,KFLEV+1) |
985 |
REAL*8 ZREFZ(KDLON,2,KFLEV+1) |
986 |
REAL*8 ZRJ(KDLON,6,KFLEV+1) |
987 |
REAL*8 ZRJ0(KDLON,6,KFLEV+1) |
988 |
REAL*8 ZRK(KDLON,6,KFLEV+1) |
989 |
REAL*8 ZRK0(KDLON,6,KFLEV+1) |
990 |
REAL*8 ZRMUE(KDLON,KFLEV+1) |
991 |
REAL*8 ZRMU0(KDLON,KFLEV+1) |
992 |
REAL*8 ZR(KDLON,4) |
993 |
REAL*8 ZTAUAZ(KDLON,KFLEV) |
994 |
REAL*8 ZTRA1(KDLON,KFLEV+1) |
995 |
REAL*8 ZTRA2(KDLON,KFLEV+1) |
996 |
REAL*8 ZW(KDLON,4) |
997 |
C |
998 |
INTEGER jl, jk, k, jaj, ikm1, ikl |
999 |
c |
1000 |
c Prescribed Data: |
1001 |
c |
1002 |
REAL*8 RSUN(2) |
1003 |
SAVE RSUN |
1004 |
REAL*8 RRAY(2,6) |
1005 |
SAVE RRAY |
1006 |
DATA RSUN(1) / 0.441676 / |
1007 |
DATA RSUN(2) / 0.558324 / |
1008 |
DATA (RRAY(1,K),K=1,6) / |
1009 |
S .428937E-01, .890743E+00,-.288555E+01, |
1010 |
S .522744E+01,-.469173E+01, .161645E+01/ |
1011 |
DATA (RRAY(2,K),K=1,6) / |
1012 |
S .697200E-02, .173297E-01,-.850903E-01, |
1013 |
S .248261E+00,-.302031E+00, .129662E+00/ |
1014 |
C ------------------------------------------------------------------ |
1015 |
C |
1016 |
C* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON) |
1017 |
C ----------------------- ------------------ |
1018 |
C |
1019 |
100 CONTINUE |
1020 |
C |
1021 |
C |
1022 |
C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING |
1023 |
C ----------------------------------------- |
1024 |
C |
1025 |
110 CONTINUE |
1026 |
C |
1027 |
DO 111 JL = 1, KDLON |
1028 |
ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL) |
1029 |
S * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL) |
1030 |
S * (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) )))) |
1031 |
111 CONTINUE |
1032 |
C |
1033 |
C |
1034 |
C ------------------------------------------------------------------ |
1035 |
C |
1036 |
C* 2. CONTINUUM SCATTERING CALCULATIONS |
1037 |
C --------------------------------- |
1038 |
C |
1039 |
200 CONTINUE |
1040 |
C |
1041 |
C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN |
1042 |
C -------------------------------- |
1043 |
C |
1044 |
210 CONTINUE |
1045 |
C |
1046 |
CALL SWCLR ( KNU |
1047 |
S , PAER , flag_aer, tauae, pizae, cgae |
1048 |
S , PALBP , PDSIG , ZRAYL, PSEC |
1049 |
S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 |
1050 |
S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2) |
1051 |
C |
1052 |
C |
1053 |
C* 2.2 CLOUDY FRACTION OF THE COLUMN |
1054 |
C ----------------------------- |
1055 |
C |
1056 |
220 CONTINUE |
1057 |
C |
1058 |
CALL SWR ( KNU |
1059 |
S , PALBD ,PCG ,PCLD ,PDSIG ,POMEGA,ZRAYL |
1060 |
S , PSEC ,PTAU |
1061 |
S , ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 ,ZREFZ ,ZRJ ,ZRK,ZRMUE |
1062 |
S , ZTAUAZ,ZTRA1 ,ZTRA2) |
1063 |
C |
1064 |
C |
1065 |
C ------------------------------------------------------------------ |
1066 |
C |
1067 |
C* 3. OZONE ABSORPTION |
1068 |
C ---------------- |
1069 |
C |
1070 |
300 CONTINUE |
1071 |
C |
1072 |
IIND(1)=1 |
1073 |
IIND(2)=3 |
1074 |
IIND(3)=1 |
1075 |
IIND(4)=3 |
1076 |
C |
1077 |
C |
1078 |
C* 3.1 DOWNWARD FLUXES |
1079 |
C --------------- |
1080 |
C |
1081 |
310 CONTINUE |
1082 |
C |
1083 |
JAJ = 2 |
1084 |
C |
1085 |
DO 311 JL = 1, KDLON |
1086 |
ZW(JL,1)=0. |
1087 |
ZW(JL,2)=0. |
1088 |
ZW(JL,3)=0. |
1089 |
ZW(JL,4)=0. |
1090 |
PFD(JL,KFLEV+1)=((1.-PCLEAR(JL))*ZRJ(JL,JAJ,KFLEV+1) |
1091 |
S + PCLEAR(JL) *ZRJ0(JL,JAJ,KFLEV+1)) * RSUN(KNU) |
1092 |
311 CONTINUE |
1093 |
DO 314 JK = 1 , KFLEV |
1094 |
IKL = KFLEV+1-JK |
1095 |
DO 312 JL = 1, KDLON |
1096 |
ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL) |
1097 |
ZW(JL,2)=ZW(JL,2)+POZ(JL, IKL)/ZRMUE(JL,IKL) |
1098 |
ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) |
1099 |
ZW(JL,4)=ZW(JL,4)+POZ(JL, IKL)/ZRMU0(JL,IKL) |
1100 |
312 CONTINUE |
1101 |
C |
1102 |
CALL SWTT1(KNU, 4, IIND, ZW, ZR) |
1103 |
C |
1104 |
DO 313 JL = 1, KDLON |
1105 |
ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRJ(JL,JAJ,IKL) |
1106 |
ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRJ0(JL,JAJ,IKL) |
1107 |
PFD(JL,IKL) = ((1.-PCLEAR(JL)) * ZDIFF(JL) |
1108 |
S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
1109 |
313 CONTINUE |
1110 |
314 CONTINUE |
1111 |
C |
1112 |
C |
1113 |
C* 3.2 UPWARD FLUXES |
1114 |
C ------------- |
1115 |
C |
1116 |
320 CONTINUE |
1117 |
C |
1118 |
DO 325 JL = 1, KDLON |
1119 |
PFU(JL,1) = ((1.-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU) |
1120 |
S + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU)) |
1121 |
S * RSUN(KNU) |
1122 |
325 CONTINUE |
1123 |
C |
1124 |
DO 328 JK = 2 , KFLEV+1 |
1125 |
IKM1=JK-1 |
1126 |
DO 326 JL = 1, KDLON |
1127 |
ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66 |
1128 |
ZW(JL,2)=ZW(JL,2)+POZ(JL, IKM1)*1.66 |
1129 |
ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66 |
1130 |
ZW(JL,4)=ZW(JL,4)+POZ(JL, IKM1)*1.66 |
1131 |
326 CONTINUE |
1132 |
C |
1133 |
CALL SWTT1(KNU, 4, IIND, ZW, ZR) |
1134 |
C |
1135 |
DO 327 JL = 1, KDLON |
1136 |
ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRK(JL,JAJ,JK) |
1137 |
ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRK0(JL,JAJ,JK) |
1138 |
PFU(JL,JK) = ((1.-PCLEAR(JL)) * ZDIFF(JL) |
1139 |
S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
1140 |
327 CONTINUE |
1141 |
328 CONTINUE |
1142 |
C |
1143 |
C ------------------------------------------------------------------ |
1144 |
C |
1145 |
RETURN |
1146 |
END |
1147 |
SUBROUTINE SW2S ( KNU |
1148 |
S , PAER , flag_aer, tauae, pizae, cgae |
1149 |
S , PAKI, PALBD, PALBP, PCG , PCLD, PCLEAR, PCLDSW |
1150 |
S , PDSIG ,POMEGA,POZ , PRMU , PSEC , PTAU |
1151 |
S , PUD ,PWV , PQS |
1152 |
S , PFDOWN,PFUP ) |
1153 |
use dimens_m |
1154 |
use dimphy |
1155 |
use raddim |
1156 |
use radepsi |
1157 |
IMPLICIT none |
1158 |
C |
1159 |
C ------------------------------------------------------------------ |
1160 |
C PURPOSE. |
1161 |
C -------- |
1162 |
C |
1163 |
C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE |
1164 |
C SECOND SPECTRAL INTERVAL FOLLOWING FOUQUART AND BONNEL (1980). |
1165 |
C |
1166 |
C METHOD. |
1167 |
C ------- |
1168 |
C |
1169 |
C 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO |
1170 |
C CONTINUUM SCATTERING |
1171 |
C 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR |
1172 |
C A GREY MOLECULAR ABSORPTION |
1173 |
C 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS |
1174 |
C OF ABSORBERS |
1175 |
C 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS |
1176 |
C 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION |
1177 |
C |
1178 |
C REFERENCE. |
1179 |
C ---------- |
1180 |
C |
1181 |
C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
1182 |
C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
1183 |
C |
1184 |
C AUTHOR. |
1185 |
C ------- |
1186 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
1187 |
C |
1188 |
C MODIFICATIONS. |
1189 |
C -------------- |
1190 |
C ORIGINAL : 89-07-14 |
1191 |
C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO |
1192 |
C ------------------------------------------------------------------ |
1193 |
C* ARGUMENTS: |
1194 |
C |
1195 |
INTEGER KNU |
1196 |
c-OB |
1197 |
real*8 flag_aer |
1198 |
real*8 tauae(kdlon,kflev,2) |
1199 |
real*8 pizae(kdlon,kflev,2) |
1200 |
real*8 cgae(kdlon,kflev,2) |
1201 |
REAL*8 PAER(KDLON,KFLEV,5) |
1202 |
REAL*8 PAKI(KDLON,2) |
1203 |
REAL*8 PALBD(KDLON,2) |
1204 |
REAL*8 PALBP(KDLON,2) |
1205 |
REAL*8 PCG(KDLON,2,KFLEV) |
1206 |
REAL*8 PCLD(KDLON,KFLEV) |
1207 |
REAL*8 PCLDSW(KDLON,KFLEV) |
1208 |
REAL*8 PCLEAR(KDLON) |
1209 |
REAL*8 PDSIG(KDLON,KFLEV) |
1210 |
REAL*8 POMEGA(KDLON,2,KFLEV) |
1211 |
REAL*8 POZ(KDLON,KFLEV) |
1212 |
REAL*8 PQS(KDLON,KFLEV) |
1213 |
REAL*8 PRMU(KDLON) |
1214 |
REAL*8 PSEC(KDLON) |
1215 |
REAL*8 PTAU(KDLON,2,KFLEV) |
1216 |
REAL*8 PUD(KDLON,5,KFLEV+1) |
1217 |
REAL*8 PWV(KDLON,KFLEV) |
1218 |
C |
1219 |
REAL*8 PFDOWN(KDLON,KFLEV+1) |
1220 |
REAL*8 PFUP(KDLON,KFLEV+1) |
1221 |
C |
1222 |
C* LOCAL VARIABLES: |
1223 |
C |
1224 |
INTEGER IIND2(2), IIND3(3) |
1225 |
REAL*8 ZCGAZ(KDLON,KFLEV) |
1226 |
REAL*8 ZFD(KDLON,KFLEV+1) |
1227 |
REAL*8 ZFU(KDLON,KFLEV+1) |
1228 |
REAL*8 ZG(KDLON) |
1229 |
REAL*8 ZGG(KDLON) |
1230 |
REAL*8 ZPIZAZ(KDLON,KFLEV) |
1231 |
REAL*8 ZRAYL(KDLON) |
1232 |
REAL*8 ZRAY1(KDLON,KFLEV+1) |
1233 |
REAL*8 ZRAY2(KDLON,KFLEV+1) |
1234 |
REAL*8 ZREF(KDLON) |
1235 |
REAL*8 ZREFZ(KDLON,2,KFLEV+1) |
1236 |
REAL*8 ZRE1(KDLON) |
1237 |
REAL*8 ZRE2(KDLON) |
1238 |
REAL*8 ZRJ(KDLON,6,KFLEV+1) |
1239 |
REAL*8 ZRJ0(KDLON,6,KFLEV+1) |
1240 |
REAL*8 ZRK(KDLON,6,KFLEV+1) |
1241 |
REAL*8 ZRK0(KDLON,6,KFLEV+1) |
1242 |
REAL*8 ZRL(KDLON,8) |
1243 |
REAL*8 ZRMUE(KDLON,KFLEV+1) |
1244 |
REAL*8 ZRMU0(KDLON,KFLEV+1) |
1245 |
REAL*8 ZRMUZ(KDLON) |
1246 |
REAL*8 ZRNEB(KDLON) |
1247 |
REAL*8 ZRUEF(KDLON,8) |
1248 |
REAL*8 ZR1(KDLON) |
1249 |
REAL*8 ZR2(KDLON,2) |
1250 |
REAL*8 ZR3(KDLON,3) |
1251 |
REAL*8 ZR4(KDLON) |
1252 |
REAL*8 ZR21(KDLON) |
1253 |
REAL*8 ZR22(KDLON) |
1254 |
REAL*8 ZS(KDLON) |
1255 |
REAL*8 ZTAUAZ(KDLON,KFLEV) |
1256 |
REAL*8 ZTO1(KDLON) |
1257 |
REAL*8 ZTR(KDLON,2,KFLEV+1) |
1258 |
REAL*8 ZTRA1(KDLON,KFLEV+1) |
1259 |
REAL*8 ZTRA2(KDLON,KFLEV+1) |
1260 |
REAL*8 ZTR1(KDLON) |
1261 |
REAL*8 ZTR2(KDLON) |
1262 |
REAL*8 ZW(KDLON) |
1263 |
REAL*8 ZW1(KDLON) |
1264 |
REAL*8 ZW2(KDLON,2) |
1265 |
REAL*8 ZW3(KDLON,3) |
1266 |
REAL*8 ZW4(KDLON) |
1267 |
REAL*8 ZW5(KDLON) |
1268 |
C |
1269 |
INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1 |
1270 |
INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs |
1271 |
REAL*8 ZRMUM1, ZWH2O, ZCNEB, ZAA, ZBB, ZRKI, ZRE11 |
1272 |
C |
1273 |
C* Prescribed Data: |
1274 |
C |
1275 |
REAL*8 RSUN(2) |
1276 |
SAVE RSUN |
1277 |
REAL*8 RRAY(2,6) |
1278 |
SAVE RRAY |
1279 |
DATA RSUN(1) / 0.441676 / |
1280 |
DATA RSUN(2) / 0.558324 / |
1281 |
DATA (RRAY(1,K),K=1,6) / |
1282 |
S .428937E-01, .890743E+00,-.288555E+01, |
1283 |
S .522744E+01,-.469173E+01, .161645E+01/ |
1284 |
DATA (RRAY(2,K),K=1,6) / |
1285 |
S .697200E-02, .173297E-01,-.850903E-01, |
1286 |
S .248261E+00,-.302031E+00, .129662E+00/ |
1287 |
C |
1288 |
C ------------------------------------------------------------------ |
1289 |
C |
1290 |
C* 1. SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON) |
1291 |
C ------------------------------------------- |
1292 |
C |
1293 |
100 CONTINUE |
1294 |
C |
1295 |
C |
1296 |
C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING |
1297 |
C ----------------------------------------- |
1298 |
C |
1299 |
110 CONTINUE |
1300 |
C |
1301 |
DO 111 JL = 1, KDLON |
1302 |
ZRMUM1 = 1. - PRMU(JL) |
1303 |
ZRAYL(JL) = RRAY(KNU,1) + ZRMUM1 * (RRAY(KNU,2) + ZRMUM1 |
1304 |
S * (RRAY(KNU,3) + ZRMUM1 * (RRAY(KNU,4) + ZRMUM1 |
1305 |
S * (RRAY(KNU,5) + ZRMUM1 * RRAY(KNU,6) )))) |
1306 |
111 CONTINUE |
1307 |
C |
1308 |
C |
1309 |
C ------------------------------------------------------------------ |
1310 |
C |
1311 |
C* 2. CONTINUUM SCATTERING CALCULATIONS |
1312 |
C --------------------------------- |
1313 |
C |
1314 |
200 CONTINUE |
1315 |
C |
1316 |
C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN |
1317 |
C -------------------------------- |
1318 |
C |
1319 |
210 CONTINUE |
1320 |
C |
1321 |
CALL SWCLR ( KNU |
1322 |
S , PAER , flag_aer, tauae, pizae, cgae |
1323 |
S , PALBP , PDSIG , ZRAYL, PSEC |
1324 |
S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 |
1325 |
S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2) |
1326 |
C |
1327 |
C |
1328 |
C* 2.2 CLOUDY FRACTION OF THE COLUMN |
1329 |
C ----------------------------- |
1330 |
C |
1331 |
220 CONTINUE |
1332 |
C |
1333 |
CALL SWR ( KNU |
1334 |
S , PALBD , PCG , PCLD , PDSIG, POMEGA, ZRAYL |
1335 |
S , PSEC , PTAU |
1336 |
S , ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2, ZREFZ , ZRJ , ZRK, ZRMUE |
1337 |
S , ZTAUAZ, ZTRA1 , ZTRA2) |
1338 |
C |
1339 |
C |
1340 |
C ------------------------------------------------------------------ |
1341 |
C |
1342 |
C* 3. SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION |
1343 |
C ------------------------------------------------------ |
1344 |
C |
1345 |
300 CONTINUE |
1346 |
C |
1347 |
JN = 2 |
1348 |
C |
1349 |
DO 361 JABS=1,2 |
1350 |
C |
1351 |
C |
1352 |
C* 3.1 SURFACE CONDITIONS |
1353 |
C ------------------ |
1354 |
C |
1355 |
310 CONTINUE |
1356 |
C |
1357 |
DO 311 JL = 1, KDLON |
1358 |
ZREFZ(JL,2,1) = PALBD(JL,KNU) |
1359 |
ZREFZ(JL,1,1) = PALBD(JL,KNU) |
1360 |
311 CONTINUE |
1361 |
C |
1362 |
C |
1363 |
C* 3.2 INTRODUCING CLOUD EFFECTS |
1364 |
C ------------------------- |
1365 |
C |
1366 |
320 CONTINUE |
1367 |
C |
1368 |
DO 324 JK = 2 , KFLEV+1 |
1369 |
JKM1 = JK - 1 |
1370 |
IKL=KFLEV+1-JKM1 |
1371 |
DO 322 JL = 1, KDLON |
1372 |
ZRNEB(JL) = PCLD(JL,JKM1) |
1373 |
IF (JABS.EQ.1 .AND. ZRNEB(JL).GT.2.*ZEELOG) THEN |
1374 |
ZWH2O=MAX(PWV(JL,JKM1),ZEELOG) |
1375 |
ZCNEB=MAX(ZEELOG,MIN(ZRNEB(JL),1.-ZEELOG)) |
1376 |
ZBB=PUD(JL,JABS,JKM1)*PQS(JL,JKM1)/ZWH2O |
1377 |
ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(1.-ZCNEB),ZEELOG) |
1378 |
ELSE |
1379 |
ZAA=PUD(JL,JABS,JKM1) |
1380 |
ZBB=ZAA |
1381 |
END IF |
1382 |
ZRKI = PAKI(JL,JABS) |
1383 |
ZS(JL) = EXP(-ZRKI * ZAA * 1.66) |
1384 |
ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK)) |
1385 |
ZTR1(JL) = 0. |
1386 |
ZRE1(JL) = 0. |
1387 |
ZTR2(JL) = 0. |
1388 |
ZRE2(JL) = 0. |
1389 |
C |
1390 |
ZW(JL)= POMEGA(JL,KNU,JKM1) |
1391 |
ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL) |
1392 |
S + ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1) |
1393 |
S + ZBB * ZRKI |
1394 |
|
1395 |
ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1) |
1396 |
ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL) |
1397 |
ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1) |
1398 |
S + (1. - ZR22(JL)) * ZCGAZ(JL,JKM1) |
1399 |
ZW(JL) = ZR21(JL) / ZTO1(JL) |
1400 |
ZREF(JL) = ZREFZ(JL,1,JKM1) |
1401 |
ZRMUZ(JL) = ZRMUE(JL,JK) |
1402 |
322 CONTINUE |
1403 |
C |
1404 |
CALL SWDE(ZGG, ZREF, ZRMUZ, ZTO1, ZW, |
1405 |
S ZRE1, ZRE2, ZTR1, ZTR2) |
1406 |
C |
1407 |
DO 323 JL = 1, KDLON |
1408 |
C |
1409 |
ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1) |
1410 |
S + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1) |
1411 |
S * ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL) |
1412 |
S + ZRNEB(JL) * ZRE1(JL) |
1413 |
C |
1414 |
ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL) |
1415 |
S + (ZTRA1(JL,JKM1)) * ZG(JL) * (1.-ZRNEB(JL)) |
1416 |
C |
1417 |
ZREFZ(JL,1,JK)=(1.-ZRNEB(JL))*(ZRAY1(JL,JKM1) |
1418 |
S +ZREFZ(JL,1,JKM1)*ZTRA1(JL,JKM1)*ZTRA2(JL,JKM1) |
1419 |
S /(1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))*ZG(JL)*ZS(JL) |
1420 |
S + ZRNEB(JL) * ZRE2(JL) |
1421 |
C |
1422 |
ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL) |
1423 |
S + (ZTRA1(JL,JKM1)/(1.-ZRAY2(JL,JKM1) |
1424 |
S * ZREFZ(JL,1,JKM1))) |
1425 |
S * ZG(JL) * (1. -ZRNEB(JL)) |
1426 |
C |
1427 |
323 CONTINUE |
1428 |
324 CONTINUE |
1429 |
C |
1430 |
C* 3.3 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
1431 |
C ------------------------------------------------- |
1432 |
C |
1433 |
330 CONTINUE |
1434 |
C |
1435 |
DO 351 JREF=1,2 |
1436 |
C |
1437 |
JN = JN + 1 |
1438 |
C |
1439 |
DO 331 JL = 1, KDLON |
1440 |
ZRJ(JL,JN,KFLEV+1) = 1. |
1441 |
ZRK(JL,JN,KFLEV+1) = ZREFZ(JL,JREF,KFLEV+1) |
1442 |
331 CONTINUE |
1443 |
C |
1444 |
DO 333 JK = 1 , KFLEV |
1445 |
JKL = KFLEV+1 - JK |
1446 |
JKLP1 = JKL + 1 |
1447 |
DO 332 JL = 1, KDLON |
1448 |
ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL) |
1449 |
ZRJ(JL,JN,JKL) = ZRE11 |
1450 |
ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL) |
1451 |
332 CONTINUE |
1452 |
333 CONTINUE |
1453 |
351 CONTINUE |
1454 |
361 CONTINUE |
1455 |
C |
1456 |
C |
1457 |
C ------------------------------------------------------------------ |
1458 |
C |
1459 |
C* 4. INVERT GREY AND CONTINUUM FLUXES |
1460 |
C -------------------------------- |
1461 |
C |
1462 |
400 CONTINUE |
1463 |
C |
1464 |
C |
1465 |
C* 4.1 UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES |
1466 |
C --------------------------------------------- |
1467 |
C |
1468 |
410 CONTINUE |
1469 |
C |
1470 |
DO 414 JK = 1 , KFLEV+1 |
1471 |
DO 413 JAJ = 1 , 5 , 2 |
1472 |
JAJP = JAJ + 1 |
1473 |
DO 412 JL = 1, KDLON |
1474 |
ZRJ(JL,JAJ,JK)= ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK) |
1475 |
ZRK(JL,JAJ,JK)= ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK) |
1476 |
ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG ) |
1477 |
ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG ) |
1478 |
412 CONTINUE |
1479 |
413 CONTINUE |
1480 |
414 CONTINUE |
1481 |
C |
1482 |
DO 417 JK = 1 , KFLEV+1 |
1483 |
DO 416 JAJ = 2 , 6 , 2 |
1484 |
DO 415 JL = 1, KDLON |
1485 |
ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG ) |
1486 |
ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG ) |
1487 |
415 CONTINUE |
1488 |
416 CONTINUE |
1489 |
417 CONTINUE |
1490 |
C |
1491 |
C* 4.2 EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE |
1492 |
C --------------------------------------------- |
1493 |
C |
1494 |
420 CONTINUE |
1495 |
C |
1496 |
DO 437 JK = 1 , KFLEV+1 |
1497 |
JKKI = 1 |
1498 |
DO 425 JAJ = 1 , 2 |
1499 |
IIND2(1)=JAJ |
1500 |
IIND2(2)=JAJ |
1501 |
DO 424 JN = 1 , 2 |
1502 |
JN2J = JN + 2 * JAJ |
1503 |
JKKP4 = JKKI + 4 |
1504 |
C |
1505 |
C* 4.2.1 EFFECTIVE ABSORBER AMOUNTS |
1506 |
C -------------------------- |
1507 |
C |
1508 |
4210 CONTINUE |
1509 |
C |
1510 |
DO 4211 JL = 1, KDLON |
1511 |
ZW2(JL,1) = LOG( ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK)) |
1512 |
S / PAKI(JL,JAJ) |
1513 |
ZW2(JL,2) = LOG( ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK)) |
1514 |
S / PAKI(JL,JAJ) |
1515 |
4211 CONTINUE |
1516 |
C |
1517 |
C* 4.2.2 TRANSMISSION FUNCTION |
1518 |
C --------------------- |
1519 |
C |
1520 |
4220 CONTINUE |
1521 |
C |
1522 |
CALL SWTT1(KNU, 2, IIND2, ZW2, ZR2) |
1523 |
C |
1524 |
DO 4221 JL = 1, KDLON |
1525 |
ZRL(JL,JKKI) = ZR2(JL,1) |
1526 |
ZRUEF(JL,JKKI) = ZW2(JL,1) |
1527 |
ZRL(JL,JKKP4) = ZR2(JL,2) |
1528 |
ZRUEF(JL,JKKP4) = ZW2(JL,2) |
1529 |
4221 CONTINUE |
1530 |
C |
1531 |
JKKI=JKKI+1 |
1532 |
424 CONTINUE |
1533 |
425 CONTINUE |
1534 |
C |
1535 |
C* 4.3 UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION |
1536 |
C ------------------------------------------------------ |
1537 |
C |
1538 |
430 CONTINUE |
1539 |
C |
1540 |
DO 431 JL = 1, KDLON |
1541 |
PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3) |
1542 |
S + ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4) |
1543 |
PFUP(JL,JK) = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7) |
1544 |
S + ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8) |
1545 |
431 CONTINUE |
1546 |
437 CONTINUE |
1547 |
C |
1548 |
C |
1549 |
C ------------------------------------------------------------------ |
1550 |
C |
1551 |
C* 5. MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES |
1552 |
C ---------------------------------------- |
1553 |
C |
1554 |
500 CONTINUE |
1555 |
C |
1556 |
C |
1557 |
C* 5.1 DOWNWARD FLUXES |
1558 |
C --------------- |
1559 |
C |
1560 |
510 CONTINUE |
1561 |
C |
1562 |
JAJ = 2 |
1563 |
IIND3(1)=1 |
1564 |
IIND3(2)=2 |
1565 |
IIND3(3)=3 |
1566 |
C |
1567 |
DO 511 JL = 1, KDLON |
1568 |
ZW3(JL,1)=0. |
1569 |
ZW3(JL,2)=0. |
1570 |
ZW3(JL,3)=0. |
1571 |
ZW4(JL) =0. |
1572 |
ZW5(JL) =0. |
1573 |
ZR4(JL) =1. |
1574 |
ZFD(JL,KFLEV+1)= ZRJ0(JL,JAJ,KFLEV+1) |
1575 |
511 CONTINUE |
1576 |
DO 514 JK = 1 , KFLEV |
1577 |
IKL = KFLEV+1-JK |
1578 |
DO 512 JL = 1, KDLON |
1579 |
ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) |
1580 |
ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)/ZRMU0(JL,IKL) |
1581 |
ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKL)/ZRMU0(JL,IKL) |
1582 |
ZW4(JL) =ZW4(JL) +PUD(JL,4,IKL)/ZRMU0(JL,IKL) |
1583 |
ZW5(JL) =ZW5(JL) +PUD(JL,5,IKL)/ZRMU0(JL,IKL) |
1584 |
512 CONTINUE |
1585 |
C |
1586 |
CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3) |
1587 |
C |
1588 |
DO 513 JL = 1, KDLON |
1589 |
C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
1590 |
ZFD(JL,IKL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL) |
1591 |
S * ZRJ0(JL,JAJ,IKL) |
1592 |
513 CONTINUE |
1593 |
514 CONTINUE |
1594 |
C |
1595 |
C |
1596 |
C* 5.2 UPWARD FLUXES |
1597 |
C ------------- |
1598 |
C |
1599 |
520 CONTINUE |
1600 |
C |
1601 |
DO 525 JL = 1, KDLON |
1602 |
ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU) |
1603 |
525 CONTINUE |
1604 |
C |
1605 |
DO 528 JK = 2 , KFLEV+1 |
1606 |
IKM1=JK-1 |
1607 |
DO 526 JL = 1, KDLON |
1608 |
ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66 |
1609 |
ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66 |
1610 |
ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKM1)*1.66 |
1611 |
ZW4(JL) =ZW4(JL) +PUD(JL,4,IKM1)*1.66 |
1612 |
ZW5(JL) =ZW5(JL) +PUD(JL,5,IKM1)*1.66 |
1613 |
526 CONTINUE |
1614 |
C |
1615 |
CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3) |
1616 |
C |
1617 |
DO 527 JL = 1, KDLON |
1618 |
C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
1619 |
ZFU(JL,JK) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL) |
1620 |
S * ZRK0(JL,JAJ,JK) |
1621 |
527 CONTINUE |
1622 |
528 CONTINUE |
1623 |
C |
1624 |
C |
1625 |
C ------------------------------------------------------------------ |
1626 |
C |
1627 |
C* 6. INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION |
1628 |
C -------------------------------------------------- |
1629 |
C |
1630 |
600 CONTINUE |
1631 |
IABS=3 |
1632 |
C |
1633 |
C* 6.1 DOWNWARD FLUXES |
1634 |
C --------------- |
1635 |
C |
1636 |
610 CONTINUE |
1637 |
DO 611 JL = 1, KDLON |
1638 |
ZW1(JL)=0. |
1639 |
ZW4(JL)=0. |
1640 |
ZW5(JL)=0. |
1641 |
ZR1(JL)=0. |
1642 |
PFDOWN(JL,KFLEV+1) = ((1.-PCLEAR(JL))*PFDOWN(JL,KFLEV+1) |
1643 |
S + PCLEAR(JL) * ZFD(JL,KFLEV+1)) * RSUN(KNU) |
1644 |
611 CONTINUE |
1645 |
C |
1646 |
DO 614 JK = 1 , KFLEV |
1647 |
IKL=KFLEV+1-JK |
1648 |
DO 612 JL = 1, KDLON |
1649 |
ZW1(JL) = ZW1(JL)+POZ(JL, IKL)/ZRMUE(JL,IKL) |
1650 |
ZW4(JL) = ZW4(JL)+PUD(JL,4,IKL)/ZRMUE(JL,IKL) |
1651 |
ZW5(JL) = ZW5(JL)+PUD(JL,5,IKL)/ZRMUE(JL,IKL) |
1652 |
C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
1653 |
612 CONTINUE |
1654 |
C |
1655 |
CALL SWTT(KNU, IABS, ZW1, ZR1) |
1656 |
C |
1657 |
DO 613 JL = 1, KDLON |
1658 |
PFDOWN(JL,IKL) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL)*PFDOWN(JL,IKL) |
1659 |
S +PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU) |
1660 |
613 CONTINUE |
1661 |
614 CONTINUE |
1662 |
C |
1663 |
C |
1664 |
C* 6.2 UPWARD FLUXES |
1665 |
C ------------- |
1666 |
C |
1667 |
620 CONTINUE |
1668 |
DO 621 JL = 1, KDLON |
1669 |
PFUP(JL,1) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,1) |
1670 |
S +PCLEAR(JL)*ZFU(JL,1)) * RSUN(KNU) |
1671 |
621 CONTINUE |
1672 |
C |
1673 |
DO 624 JK = 2 , KFLEV+1 |
1674 |
IKM1=JK-1 |
1675 |
DO 622 JL = 1, KDLON |
1676 |
ZW1(JL) = ZW1(JL)+POZ(JL ,IKM1)*1.66 |
1677 |
ZW4(JL) = ZW4(JL)+PUD(JL,4,IKM1)*1.66 |
1678 |
ZW5(JL) = ZW5(JL)+PUD(JL,5,IKM1)*1.66 |
1679 |
C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
1680 |
622 CONTINUE |
1681 |
C |
1682 |
CALL SWTT(KNU, IABS, ZW1, ZR1) |
1683 |
C |
1684 |
DO 623 JL = 1, KDLON |
1685 |
PFUP(JL,JK) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,JK) |
1686 |
S +PCLEAR(JL)*ZFU(JL,JK)) * RSUN(KNU) |
1687 |
623 CONTINUE |
1688 |
624 CONTINUE |
1689 |
C |
1690 |
C ------------------------------------------------------------------ |
1691 |
C |
1692 |
RETURN |
1693 |
END |
1694 |
SUBROUTINE SWCLR ( KNU |
1695 |
S , PAER , flag_aer, tauae, pizae, cgae |
1696 |
S , PALBP , PDSIG , PRAYL , PSEC |
1697 |
S , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ |
1698 |
S , PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 ) |
1699 |
use dimens_m |
1700 |
use dimphy |
1701 |
use raddim |
1702 |
use radepsi |
1703 |
use radopt |
1704 |
IMPLICIT none |
1705 |
C |
1706 |
C ------------------------------------------------------------------ |
1707 |
C PURPOSE. |
1708 |
C -------- |
1709 |
C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF |
1710 |
C CLEAR-SKY COLUMN |
1711 |
C |
1712 |
C REFERENCE. |
1713 |
C ---------- |
1714 |
C |
1715 |
C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
1716 |
C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
1717 |
C |
1718 |
C AUTHOR. |
1719 |
C ------- |
1720 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
1721 |
C |
1722 |
C MODIFICATIONS. |
1723 |
C -------------- |
1724 |
C ORIGINAL : 94-11-15 |
1725 |
C ------------------------------------------------------------------ |
1726 |
C* ARGUMENTS: |
1727 |
C |
1728 |
INTEGER KNU |
1729 |
c-OB |
1730 |
real*8 flag_aer |
1731 |
real*8 tauae(kdlon,kflev,2) |
1732 |
real*8 pizae(kdlon,kflev,2) |
1733 |
real*8 cgae(kdlon,kflev,2) |
1734 |
REAL*8 PAER(KDLON,KFLEV,5) |
1735 |
REAL*8 PALBP(KDLON,2) |
1736 |
REAL*8 PDSIG(KDLON,KFLEV) |
1737 |
REAL*8 PRAYL(KDLON) |
1738 |
REAL*8 PSEC(KDLON) |
1739 |
C |
1740 |
REAL*8 PCGAZ(KDLON,KFLEV) |
1741 |
REAL*8 PPIZAZ(KDLON,KFLEV) |
1742 |
REAL*8 PRAY1(KDLON,KFLEV+1) |
1743 |
REAL*8 PRAY2(KDLON,KFLEV+1) |
1744 |
REAL*8 PREFZ(KDLON,2,KFLEV+1) |
1745 |
REAL*8 PRJ(KDLON,6,KFLEV+1) |
1746 |
REAL*8 PRK(KDLON,6,KFLEV+1) |
1747 |
REAL*8 PRMU0(KDLON,KFLEV+1) |
1748 |
REAL*8 PTAUAZ(KDLON,KFLEV) |
1749 |
REAL*8 PTRA1(KDLON,KFLEV+1) |
1750 |
REAL*8 PTRA2(KDLON,KFLEV+1) |
1751 |
C |
1752 |
C* LOCAL VARIABLES: |
1753 |
C |
1754 |
REAL*8 ZC0I(KDLON,KFLEV+1) |
1755 |
REAL*8 ZCLE0(KDLON,KFLEV) |
1756 |
REAL*8 ZCLEAR(KDLON) |
1757 |
REAL*8 ZR21(KDLON) |
1758 |
REAL*8 ZR23(KDLON) |
1759 |
REAL*8 ZSS0(KDLON) |
1760 |
REAL*8 ZSCAT(KDLON) |
1761 |
REAL*8 ZTR(KDLON,2,KFLEV+1) |
1762 |
C |
1763 |
INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in |
1764 |
REAL*8 ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE |
1765 |
REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1 |
1766 |
REAL*8 ZBMU0, ZBMU1, ZRE11 |
1767 |
C |
1768 |
C* Prescribed Data for Aerosols: |
1769 |
C |
1770 |
REAL*8 TAUA(2,5), RPIZA(2,5), RCGA(2,5) |
1771 |
SAVE TAUA, RPIZA, RCGA |
1772 |
DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) / |
1773 |
S .730719, .912819, .725059, .745405, .682188 , |
1774 |
S .730719, .912819, .725059, .745405, .682188 / |
1775 |
DATA ((RPIZA(IN,JA),JA=1,5),IN=1,2) / |
1776 |
S .872212, .982545, .623143, .944887, .997975 , |
1777 |
S .872212, .982545, .623143, .944887, .997975 / |
1778 |
DATA ((RCGA (IN,JA),JA=1,5),IN=1,2) / |
1779 |
S .647596, .739002, .580845, .662657, .624246 , |
1780 |
S .647596, .739002, .580845, .662657, .624246 / |
1781 |
C ------------------------------------------------------------------ |
1782 |
C |
1783 |
C* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH |
1784 |
C -------------------------------------------- |
1785 |
C |
1786 |
100 CONTINUE |
1787 |
C |
1788 |
DO 103 JK = 1 , KFLEV+1 |
1789 |
DO 102 JA = 1 , 6 |
1790 |
DO 101 JL = 1, KDLON |
1791 |
PRJ(JL,JA,JK) = 0. |
1792 |
PRK(JL,JA,JK) = 0. |
1793 |
101 CONTINUE |
1794 |
102 CONTINUE |
1795 |
103 CONTINUE |
1796 |
C |
1797 |
DO 108 JK = 1 , KFLEV |
1798 |
c-OB |
1799 |
c DO 104 JL = 1, KDLON |
1800 |
c PCGAZ(JL,JK) = 0. |
1801 |
c PPIZAZ(JL,JK) = 0. |
1802 |
c PTAUAZ(JL,JK) = 0. |
1803 |
c 104 CONTINUE |
1804 |
c-OB |
1805 |
c DO 106 JAE=1,5 |
1806 |
c DO 105 JL = 1, KDLON |
1807 |
c PTAUAZ(JL,JK)=PTAUAZ(JL,JK) |
1808 |
c S +PAER(JL,JK,JAE)*TAUA(KNU,JAE) |
1809 |
c PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE) |
1810 |
c S * TAUA(KNU,JAE)*RPIZA(KNU,JAE) |
1811 |
c PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JK,JAE) |
1812 |
c S * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) |
1813 |
c 105 CONTINUE |
1814 |
c 106 CONTINUE |
1815 |
c-OB |
1816 |
DO 105 JL = 1, KDLON |
1817 |
PTAUAZ(JL,JK)=flag_aer * tauae(JL,JK,KNU) |
1818 |
PPIZAZ(JL,JK)=flag_aer * pizae(JL,JK,KNU) |
1819 |
PCGAZ (JL,JK)=flag_aer * cgae(JL,JK,KNU) |
1820 |
105 CONTINUE |
1821 |
C |
1822 |
IF (flag_aer.GT.0) THEN |
1823 |
c-OB |
1824 |
DO 107 JL = 1, KDLON |
1825 |
c PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK) |
1826 |
c PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK) |
1827 |
ZTRAY = PRAYL(JL) * PDSIG(JL,JK) |
1828 |
ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK)) |
1829 |
ZGAR = PCGAZ(JL,JK) |
1830 |
ZFF = ZGAR * ZGAR |
1831 |
PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.-PPIZAZ(JL,JK)*ZFF) |
1832 |
PCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR) |
1833 |
PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*PPIZAZ(JL,JK)*(1.-ZFF) |
1834 |
S / (1. - PPIZAZ(JL,JK) * ZFF) |
1835 |
107 CONTINUE |
1836 |
ELSE |
1837 |
DO JL = 1, KDLON |
1838 |
ZTRAY = PRAYL(JL) * PDSIG(JL,JK) |
1839 |
PTAUAZ(JL,JK) = ZTRAY |
1840 |
PCGAZ(JL,JK) = 0. |
1841 |
PPIZAZ(JL,JK) = 1.-REPSCT |
1842 |
END DO |
1843 |
END IF ! check flag_aer |
1844 |
c 107 CONTINUE |
1845 |
c PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5) |
1846 |
c $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON) |
1847 |
c 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5) |
1848 |
C |
1849 |
108 CONTINUE |
1850 |
C |
1851 |
C ------------------------------------------------------------------ |
1852 |
C |
1853 |
C* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL |
1854 |
C ---------------------------------------------- |
1855 |
C |
1856 |
200 CONTINUE |
1857 |
C |
1858 |
DO 201 JL = 1, KDLON |
1859 |
ZR23(JL) = 0. |
1860 |
ZC0I(JL,KFLEV+1) = 0. |
1861 |
ZCLEAR(JL) = 1. |
1862 |
ZSCAT(JL) = 0. |
1863 |
201 CONTINUE |
1864 |
C |
1865 |
JK = 1 |
1866 |
JKL = KFLEV+1 - JK |
1867 |
JKLP1 = JKL + 1 |
1868 |
DO 202 JL = 1, KDLON |
1869 |
ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
1870 |
ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
1871 |
ZR21(JL) = EXP(-ZCORAE ) |
1872 |
ZSS0(JL) = 1.-ZR21(JL) |
1873 |
ZCLE0(JL,JKL) = ZSS0(JL) |
1874 |
C |
1875 |
IF (NOVLP.EQ.1) THEN |
1876 |
c* maximum-random |
1877 |
ZCLEAR(JL) = ZCLEAR(JL) |
1878 |
S *(1.0-MAX(ZSS0(JL),ZSCAT(JL))) |
1879 |
S /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC)) |
1880 |
ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL) |
1881 |
ZSCAT(JL) = ZSS0(JL) |
1882 |
ELSE IF (NOVLP.EQ.2) THEN |
1883 |
C* maximum |
1884 |
ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) ) |
1885 |
ZC0I(JL,JKL) = ZSCAT(JL) |
1886 |
ELSE IF (NOVLP.EQ.3) THEN |
1887 |
c* random |
1888 |
ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL)) |
1889 |
ZSCAT(JL) = 1.0 - ZCLEAR(JL) |
1890 |
ZC0I(JL,JKL) = ZSCAT(JL) |
1891 |
END IF |
1892 |
202 CONTINUE |
1893 |
C |
1894 |
DO 205 JK = 2 , KFLEV |
1895 |
JKL = KFLEV+1 - JK |
1896 |
JKLP1 = JKL + 1 |
1897 |
DO 204 JL = 1, KDLON |
1898 |
ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
1899 |
ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
1900 |
ZR21(JL) = EXP(-ZCORAE ) |
1901 |
ZSS0(JL) = 1.-ZR21(JL) |
1902 |
ZCLE0(JL,JKL) = ZSS0(JL) |
1903 |
c |
1904 |
IF (NOVLP.EQ.1) THEN |
1905 |
c* maximum-random |
1906 |
ZCLEAR(JL) = ZCLEAR(JL) |
1907 |
S *(1.0-MAX(ZSS0(JL),ZSCAT(JL))) |
1908 |
S /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC)) |
1909 |
ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL) |
1910 |
ZSCAT(JL) = ZSS0(JL) |
1911 |
ELSE IF (NOVLP.EQ.2) THEN |
1912 |
C* maximum |
1913 |
ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) ) |
1914 |
ZC0I(JL,JKL) = ZSCAT(JL) |
1915 |
ELSE IF (NOVLP.EQ.3) THEN |
1916 |
c* random |
1917 |
ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL)) |
1918 |
ZSCAT(JL) = 1.0 - ZCLEAR(JL) |
1919 |
ZC0I(JL,JKL) = ZSCAT(JL) |
1920 |
END IF |
1921 |
204 CONTINUE |
1922 |
205 CONTINUE |
1923 |
C |
1924 |
C ------------------------------------------------------------------ |
1925 |
C |
1926 |
C* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING |
1927 |
C ----------------------------------------------- |
1928 |
C |
1929 |
300 CONTINUE |
1930 |
C |
1931 |
DO 301 JL = 1, KDLON |
1932 |
PRAY1(JL,KFLEV+1) = 0. |
1933 |
PRAY2(JL,KFLEV+1) = 0. |
1934 |
PREFZ(JL,2,1) = PALBP(JL,KNU) |
1935 |
PREFZ(JL,1,1) = PALBP(JL,KNU) |
1936 |
PTRA1(JL,KFLEV+1) = 1. |
1937 |
PTRA2(JL,KFLEV+1) = 1. |
1938 |
301 CONTINUE |
1939 |
C |
1940 |
DO 346 JK = 2 , KFLEV+1 |
1941 |
JKM1 = JK-1 |
1942 |
DO 342 JL = 1, KDLON |
1943 |
C |
1944 |
C |
1945 |
C ------------------------------------------------------------------ |
1946 |
C |
1947 |
C* 3.1 EQUIVALENT ZENITH ANGLE |
1948 |
C ----------------------- |
1949 |
C |
1950 |
310 CONTINUE |
1951 |
C |
1952 |
ZMUE = (1.-ZC0I(JL,JK)) * PSEC(JL) |
1953 |
S + ZC0I(JL,JK) * 1.66 |
1954 |
PRMU0(JL,JK) = 1./ZMUE |
1955 |
C |
1956 |
C |
1957 |
C ------------------------------------------------------------------ |
1958 |
C |
1959 |
C* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS |
1960 |
C ---------------------------------------------------- |
1961 |
C |
1962 |
320 CONTINUE |
1963 |
C |
1964 |
ZGAP = PCGAZ(JL,JKM1) |
1965 |
ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE |
1966 |
ZWW = PPIZAZ(JL,JKM1) |
1967 |
ZTO = PTAUAZ(JL,JKM1) |
1968 |
ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE |
1969 |
S + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE |
1970 |
PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN |
1971 |
PTRA1(JL,JKM1) = 1. / ZDEN |
1972 |
C |
1973 |
ZMU1 = 0.5 |
1974 |
ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1 |
1975 |
ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1 |
1976 |
S + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1 |
1977 |
PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1 |
1978 |
PTRA2(JL,JKM1) = 1. / ZDEN1 |
1979 |
C |
1980 |
C |
1981 |
C |
1982 |
PREFZ(JL,1,JK) = (PRAY1(JL,JKM1) |
1983 |
S + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1) |
1984 |
S * PTRA2(JL,JKM1) |
1985 |
S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
1986 |
C |
1987 |
ZTR(JL,1,JKM1) = (PTRA1(JL,JKM1) |
1988 |
S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
1989 |
C |
1990 |
PREFZ(JL,2,JK) = (PRAY1(JL,JKM1) |
1991 |
S + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1) |
1992 |
S * PTRA2(JL,JKM1) ) |
1993 |
C |
1994 |
ZTR(JL,2,JKM1) = PTRA1(JL,JKM1) |
1995 |
C |
1996 |
342 CONTINUE |
1997 |
346 CONTINUE |
1998 |
DO 347 JL = 1, KDLON |
1999 |
ZMUE = (1.-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66 |
2000 |
PRMU0(JL,1)=1./ZMUE |
2001 |
347 CONTINUE |
2002 |
C |
2003 |
C |
2004 |
C ------------------------------------------------------------------ |
2005 |
C |
2006 |
C* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
2007 |
C ------------------------------------------------- |
2008 |
C |
2009 |
350 CONTINUE |
2010 |
C |
2011 |
IF (KNU.EQ.1) THEN |
2012 |
JAJ = 2 |
2013 |
DO 351 JL = 1, KDLON |
2014 |
PRJ(JL,JAJ,KFLEV+1) = 1. |
2015 |
PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1) |
2016 |
351 CONTINUE |
2017 |
C |
2018 |
DO 353 JK = 1 , KFLEV |
2019 |
JKL = KFLEV+1 - JK |
2020 |
JKLP1 = JKL + 1 |
2021 |
DO 352 JL = 1, KDLON |
2022 |
ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL) |
2023 |
PRJ(JL,JAJ,JKL) = ZRE11 |
2024 |
PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL) |
2025 |
352 CONTINUE |
2026 |
353 CONTINUE |
2027 |
354 CONTINUE |
2028 |
C |
2029 |
ELSE |
2030 |
C |
2031 |
DO 358 JAJ = 1 , 2 |
2032 |
DO 355 JL = 1, KDLON |
2033 |
PRJ(JL,JAJ,KFLEV+1) = 1. |
2034 |
PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1) |
2035 |
355 CONTINUE |
2036 |
C |
2037 |
DO 357 JK = 1 , KFLEV |
2038 |
JKL = KFLEV+1 - JK |
2039 |
JKLP1 = JKL + 1 |
2040 |
DO 356 JL = 1, KDLON |
2041 |
ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL) |
2042 |
PRJ(JL,JAJ,JKL) = ZRE11 |
2043 |
PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL) |
2044 |
356 CONTINUE |
2045 |
357 CONTINUE |
2046 |
358 CONTINUE |
2047 |
C |
2048 |
END IF |
2049 |
C |
2050 |
C ------------------------------------------------------------------ |
2051 |
C |
2052 |
RETURN |
2053 |
END |
2054 |
SUBROUTINE SWR ( KNU |
2055 |
S , PALBD , PCG , PCLD , PDSIG, POMEGA, PRAYL |
2056 |
S , PSEC , PTAU |
2057 |
S , PCGAZ , PPIZAZ, PRAY1, PRAY2, PREFZ , PRJ , PRK , PRMUE |
2058 |
S , PTAUAZ, PTRA1 , PTRA2 ) |
2059 |
use dimens_m |
2060 |
use dimphy |
2061 |
use raddim |
2062 |
use radepsi |
2063 |
use radopt |
2064 |
IMPLICIT none |
2065 |
C |
2066 |
C ------------------------------------------------------------------ |
2067 |
C PURPOSE. |
2068 |
C -------- |
2069 |
C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF |
2070 |
C CONTINUUM SCATTERING |
2071 |
C |
2072 |
C METHOD. |
2073 |
C ------- |
2074 |
C |
2075 |
C 1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL |
2076 |
C OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION) |
2077 |
C |
2078 |
C REFERENCE. |
2079 |
C ---------- |
2080 |
C |
2081 |
C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
2082 |
C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
2083 |
C |
2084 |
C AUTHOR. |
2085 |
C ------- |
2086 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
2087 |
C |
2088 |
C MODIFICATIONS. |
2089 |
C -------------- |
2090 |
C ORIGINAL : 89-07-14 |
2091 |
C ------------------------------------------------------------------ |
2092 |
C* ARGUMENTS: |
2093 |
C |
2094 |
INTEGER KNU |
2095 |
REAL*8 PALBD(KDLON,2) |
2096 |
REAL*8 PCG(KDLON,2,KFLEV) |
2097 |
REAL*8 PCLD(KDLON,KFLEV) |
2098 |
REAL*8 PDSIG(KDLON,KFLEV) |
2099 |
REAL*8 POMEGA(KDLON,2,KFLEV) |
2100 |
REAL*8 PRAYL(KDLON) |
2101 |
REAL*8 PSEC(KDLON) |
2102 |
REAL*8 PTAU(KDLON,2,KFLEV) |
2103 |
C |
2104 |
REAL*8 PRAY1(KDLON,KFLEV+1) |
2105 |
REAL*8 PRAY2(KDLON,KFLEV+1) |
2106 |
REAL*8 PREFZ(KDLON,2,KFLEV+1) |
2107 |
REAL*8 PRJ(KDLON,6,KFLEV+1) |
2108 |
REAL*8 PRK(KDLON,6,KFLEV+1) |
2109 |
REAL*8 PRMUE(KDLON,KFLEV+1) |
2110 |
REAL*8 PCGAZ(KDLON,KFLEV) |
2111 |
REAL*8 PPIZAZ(KDLON,KFLEV) |
2112 |
REAL*8 PTAUAZ(KDLON,KFLEV) |
2113 |
REAL*8 PTRA1(KDLON,KFLEV+1) |
2114 |
REAL*8 PTRA2(KDLON,KFLEV+1) |
2115 |
C |
2116 |
C* LOCAL VARIABLES: |
2117 |
C |
2118 |
REAL*8 ZC1I(KDLON,KFLEV+1) |
2119 |
REAL*8 ZCLEQ(KDLON,KFLEV) |
2120 |
REAL*8 ZCLEAR(KDLON) |
2121 |
REAL*8 ZCLOUD(KDLON) |
2122 |
REAL*8 ZGG(KDLON) |
2123 |
REAL*8 ZREF(KDLON) |
2124 |
REAL*8 ZRE1(KDLON) |
2125 |
REAL*8 ZRE2(KDLON) |
2126 |
REAL*8 ZRMUZ(KDLON) |
2127 |
REAL*8 ZRNEB(KDLON) |
2128 |
REAL*8 ZR21(KDLON) |
2129 |
REAL*8 ZR22(KDLON) |
2130 |
REAL*8 ZR23(KDLON) |
2131 |
REAL*8 ZSS1(KDLON) |
2132 |
REAL*8 ZTO1(KDLON) |
2133 |
REAL*8 ZTR(KDLON,2,KFLEV+1) |
2134 |
REAL*8 ZTR1(KDLON) |
2135 |
REAL*8 ZTR2(KDLON) |
2136 |
REAL*8 ZW(KDLON) |
2137 |
C |
2138 |
INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj |
2139 |
REAL*8 ZFACOA, ZFACOC, ZCORAE, ZCORCD |
2140 |
REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZDEN1 |
2141 |
REAL*8 ZMU1, ZRE11, ZBMU0, ZBMU1 |
2142 |
C |
2143 |
C ------------------------------------------------------------------ |
2144 |
C |
2145 |
C* 1. INITIALIZATION |
2146 |
C -------------- |
2147 |
C |
2148 |
100 CONTINUE |
2149 |
C |
2150 |
DO 103 JK = 1 , KFLEV+1 |
2151 |
DO 102 JA = 1 , 6 |
2152 |
DO 101 JL = 1, KDLON |
2153 |
PRJ(JL,JA,JK) = 0. |
2154 |
PRK(JL,JA,JK) = 0. |
2155 |
101 CONTINUE |
2156 |
102 CONTINUE |
2157 |
103 CONTINUE |
2158 |
C |
2159 |
C |
2160 |
C ------------------------------------------------------------------ |
2161 |
C |
2162 |
C* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL |
2163 |
C ---------------------------------------------- |
2164 |
C |
2165 |
200 CONTINUE |
2166 |
C |
2167 |
DO 201 JL = 1, KDLON |
2168 |
ZR23(JL) = 0. |
2169 |
ZC1I(JL,KFLEV+1) = 0. |
2170 |
ZCLEAR(JL) = 1. |
2171 |
ZCLOUD(JL) = 0. |
2172 |
201 CONTINUE |
2173 |
C |
2174 |
JK = 1 |
2175 |
JKL = KFLEV+1 - JK |
2176 |
JKLP1 = JKL + 1 |
2177 |
DO 202 JL = 1, KDLON |
2178 |
ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
2179 |
ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL) |
2180 |
S * PCG(JL,KNU,JKL) |
2181 |
ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
2182 |
ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL) |
2183 |
ZR21(JL) = EXP(-ZCORAE ) |
2184 |
ZR22(JL) = EXP(-ZCORCD ) |
2185 |
ZSS1(JL) = PCLD(JL,JKL)*(1.0-ZR21(JL)*ZR22(JL)) |
2186 |
S + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL)) |
2187 |
ZCLEQ(JL,JKL) = ZSS1(JL) |
2188 |
C |
2189 |
IF (NOVLP.EQ.1) THEN |
2190 |
c* maximum-random |
2191 |
ZCLEAR(JL) = ZCLEAR(JL) |
2192 |
S *(1.0-MAX(ZSS1(JL),ZCLOUD(JL))) |
2193 |
S /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
2194 |
ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL) |
2195 |
ZCLOUD(JL) = ZSS1(JL) |
2196 |
ELSE IF (NOVLP.EQ.2) THEN |
2197 |
C* maximum |
2198 |
ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) ) |
2199 |
ZC1I(JL,JKL) = ZCLOUD(JL) |
2200 |
ELSE IF (NOVLP.EQ.3) THEN |
2201 |
c* random |
2202 |
ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL)) |
2203 |
ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
2204 |
ZC1I(JL,JKL) = ZCLOUD(JL) |
2205 |
END IF |
2206 |
202 CONTINUE |
2207 |
C |
2208 |
DO 205 JK = 2 , KFLEV |
2209 |
JKL = KFLEV+1 - JK |
2210 |
JKLP1 = JKL + 1 |
2211 |
DO 204 JL = 1, KDLON |
2212 |
ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
2213 |
ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL) |
2214 |
S * PCG(JL,KNU,JKL) |
2215 |
ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
2216 |
ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL) |
2217 |
ZR21(JL) = EXP(-ZCORAE ) |
2218 |
ZR22(JL) = EXP(-ZCORCD ) |
2219 |
ZSS1(JL) = PCLD(JL,JKL)*(1.0-ZR21(JL)*ZR22(JL)) |
2220 |
S + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL)) |
2221 |
ZCLEQ(JL,JKL) = ZSS1(JL) |
2222 |
c |
2223 |
IF (NOVLP.EQ.1) THEN |
2224 |
c* maximum-random |
2225 |
ZCLEAR(JL) = ZCLEAR(JL) |
2226 |
S *(1.0-MAX(ZSS1(JL),ZCLOUD(JL))) |
2227 |
S /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
2228 |
ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL) |
2229 |
ZCLOUD(JL) = ZSS1(JL) |
2230 |
ELSE IF (NOVLP.EQ.2) THEN |
2231 |
C* maximum |
2232 |
ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) ) |
2233 |
ZC1I(JL,JKL) = ZCLOUD(JL) |
2234 |
ELSE IF (NOVLP.EQ.3) THEN |
2235 |
c* random |
2236 |
ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL)) |
2237 |
ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
2238 |
ZC1I(JL,JKL) = ZCLOUD(JL) |
2239 |
END IF |
2240 |
204 CONTINUE |
2241 |
205 CONTINUE |
2242 |
C |
2243 |
C ------------------------------------------------------------------ |
2244 |
C |
2245 |
C* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING |
2246 |
C ----------------------------------------------- |
2247 |
C |
2248 |
300 CONTINUE |
2249 |
C |
2250 |
DO 301 JL = 1, KDLON |
2251 |
PRAY1(JL,KFLEV+1) = 0. |
2252 |
PRAY2(JL,KFLEV+1) = 0. |
2253 |
PREFZ(JL,2,1) = PALBD(JL,KNU) |
2254 |
PREFZ(JL,1,1) = PALBD(JL,KNU) |
2255 |
PTRA1(JL,KFLEV+1) = 1. |
2256 |
PTRA2(JL,KFLEV+1) = 1. |
2257 |
301 CONTINUE |
2258 |
C |
2259 |
DO 346 JK = 2 , KFLEV+1 |
2260 |
JKM1 = JK-1 |
2261 |
DO 342 JL = 1, KDLON |
2262 |
ZRNEB(JL)= PCLD(JL,JKM1) |
2263 |
ZRE1(JL)=0. |
2264 |
ZTR1(JL)=0. |
2265 |
ZRE2(JL)=0. |
2266 |
ZTR2(JL)=0. |
2267 |
C |
2268 |
C |
2269 |
C ------------------------------------------------------------------ |
2270 |
C |
2271 |
C* 3.1 EQUIVALENT ZENITH ANGLE |
2272 |
C ----------------------- |
2273 |
C |
2274 |
310 CONTINUE |
2275 |
C |
2276 |
ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL) |
2277 |
S + ZC1I(JL,JK) * 1.66 |
2278 |
PRMUE(JL,JK) = 1./ZMUE |
2279 |
C |
2280 |
C |
2281 |
C ------------------------------------------------------------------ |
2282 |
C |
2283 |
C* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS |
2284 |
C ---------------------------------------------------- |
2285 |
C |
2286 |
320 CONTINUE |
2287 |
C |
2288 |
ZGAP = PCGAZ(JL,JKM1) |
2289 |
ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE |
2290 |
ZWW = PPIZAZ(JL,JKM1) |
2291 |
ZTO = PTAUAZ(JL,JKM1) |
2292 |
ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE |
2293 |
S + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE |
2294 |
PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN |
2295 |
PTRA1(JL,JKM1) = 1. / ZDEN |
2296 |
c PRINT *,' LOOP 342 ** 3 ** JL=',JL,PRAY1(JL,JKM1),PTRA1(JL,JKM1) |
2297 |
C |
2298 |
ZMU1 = 0.5 |
2299 |
ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1 |
2300 |
ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1 |
2301 |
S + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1 |
2302 |
PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1 |
2303 |
PTRA2(JL,JKM1) = 1. / ZDEN1 |
2304 |
C |
2305 |
C |
2306 |
C ------------------------------------------------------------------ |
2307 |
C |
2308 |
C* 3.3 EFFECT OF CLOUD LAYER |
2309 |
C --------------------- |
2310 |
C |
2311 |
330 CONTINUE |
2312 |
C |
2313 |
ZW(JL) = POMEGA(JL,KNU,JKM1) |
2314 |
ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL) |
2315 |
S + PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1) |
2316 |
ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1) |
2317 |
ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL) |
2318 |
ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1) |
2319 |
S + (1. - ZR22(JL)) * PCGAZ(JL,JKM1) |
2320 |
C Modif PhD - JJM 19/03/96 pour erreurs arrondis |
2321 |
C machine |
2322 |
C PHD PROTECTION ZW(JL) = ZR21(JL) / ZTO1(JL) |
2323 |
IF (ZW(JL).EQ.1. .AND. PPIZAZ(JL,JKM1).EQ.1.) THEN |
2324 |
ZW(JL)=1. |
2325 |
ELSE |
2326 |
ZW(JL) = ZR21(JL) / ZTO1(JL) |
2327 |
END IF |
2328 |
ZREF(JL) = PREFZ(JL,1,JKM1) |
2329 |
ZRMUZ(JL) = PRMUE(JL,JK) |
2330 |
342 CONTINUE |
2331 |
C |
2332 |
CALL SWDE(ZGG , ZREF , ZRMUZ , ZTO1 , ZW, |
2333 |
S ZRE1 , ZRE2 , ZTR1 , ZTR2) |
2334 |
C |
2335 |
DO 345 JL = 1, KDLON |
2336 |
C |
2337 |
PREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1) |
2338 |
S + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1) |
2339 |
S * PTRA2(JL,JKM1) |
2340 |
S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
2341 |
S + ZRNEB(JL) * ZRE2(JL) |
2342 |
C |
2343 |
ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1) |
2344 |
S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
2345 |
S * (1.-ZRNEB(JL)) |
2346 |
C |
2347 |
PREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1) |
2348 |
S + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1) |
2349 |
S * PTRA2(JL,JKM1) ) |
2350 |
S + ZRNEB(JL) * ZRE1(JL) |
2351 |
C |
2352 |
ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL) |
2353 |
S + PTRA1(JL,JKM1) * (1.-ZRNEB(JL)) |
2354 |
C |
2355 |
345 CONTINUE |
2356 |
346 CONTINUE |
2357 |
DO 347 JL = 1, KDLON |
2358 |
ZMUE = (1.-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66 |
2359 |
PRMUE(JL,1)=1./ZMUE |
2360 |
347 CONTINUE |
2361 |
C |
2362 |
C |
2363 |
C ------------------------------------------------------------------ |
2364 |
C |
2365 |
C* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
2366 |
C ------------------------------------------------- |
2367 |
C |
2368 |
350 CONTINUE |
2369 |
C |
2370 |
IF (KNU.EQ.1) THEN |
2371 |
JAJ = 2 |
2372 |
DO 351 JL = 1, KDLON |
2373 |
PRJ(JL,JAJ,KFLEV+1) = 1. |
2374 |
PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1) |
2375 |
351 CONTINUE |
2376 |
C |
2377 |
DO 353 JK = 1 , KFLEV |
2378 |
JKL = KFLEV+1 - JK |
2379 |
JKLP1 = JKL + 1 |
2380 |
DO 352 JL = 1, KDLON |
2381 |
ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL) |
2382 |
PRJ(JL,JAJ,JKL) = ZRE11 |
2383 |
PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL) |
2384 |
352 CONTINUE |
2385 |
353 CONTINUE |
2386 |
354 CONTINUE |
2387 |
C |
2388 |
ELSE |
2389 |
C |
2390 |
DO 358 JAJ = 1 , 2 |
2391 |
DO 355 JL = 1, KDLON |
2392 |
PRJ(JL,JAJ,KFLEV+1) = 1. |
2393 |
PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1) |
2394 |
355 CONTINUE |
2395 |
C |
2396 |
DO 357 JK = 1 , KFLEV |
2397 |
JKL = KFLEV+1 - JK |
2398 |
JKLP1 = JKL + 1 |
2399 |
DO 356 JL = 1, KDLON |
2400 |
ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL) |
2401 |
PRJ(JL,JAJ,JKL) = ZRE11 |
2402 |
PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL) |
2403 |
356 CONTINUE |
2404 |
357 CONTINUE |
2405 |
358 CONTINUE |
2406 |
C |
2407 |
END IF |
2408 |
C |
2409 |
C ------------------------------------------------------------------ |
2410 |
C |
2411 |
RETURN |
2412 |
END |
2413 |
SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW, |
2414 |
S PRE1,PRE2,PTR1,PTR2) |
2415 |
use dimens_m |
2416 |
use dimphy |
2417 |
use raddim |
2418 |
IMPLICIT none |
2419 |
C |
2420 |
C ------------------------------------------------------------------ |
2421 |
C PURPOSE. |
2422 |
C -------- |
2423 |
C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY |
2424 |
C LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION. |
2425 |
C |
2426 |
C METHOD. |
2427 |
C ------- |
2428 |
C |
2429 |
C STANDARD DELTA-EDDINGTON LAYER CALCULATIONS. |
2430 |
C |
2431 |
C REFERENCE. |
2432 |
C ---------- |
2433 |
C |
2434 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
2435 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
2436 |
C |
2437 |
C AUTHOR. |
2438 |
C ------- |
2439 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
2440 |
C |
2441 |
C MODIFICATIONS. |
2442 |
C -------------- |
2443 |
C ORIGINAL : 88-12-15 |
2444 |
C ------------------------------------------------------------------ |
2445 |
C* ARGUMENTS: |
2446 |
C |
2447 |
REAL*8 PGG(KDLON) ! ASSYMETRY FACTOR |
2448 |
REAL*8 PREF(KDLON) ! REFLECTIVITY OF THE UNDERLYING LAYER |
2449 |
REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE |
2450 |
REAL*8 PTO1(KDLON) ! OPTICAL THICKNESS |
2451 |
REAL*8 PW(KDLON) ! SINGLE SCATTERING ALBEDO |
2452 |
REAL*8 PRE1(KDLON) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION) |
2453 |
REAL*8 PRE2(KDLON) ! LAYER REFLECTIVITY |
2454 |
REAL*8 PTR1(KDLON) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION) |
2455 |
REAL*8 PTR2(KDLON) ! LAYER TRANSMISSIVITY |
2456 |
C |
2457 |
C* LOCAL VARIABLES: |
2458 |
C |
2459 |
INTEGER jl |
2460 |
REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM |
2461 |
REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG |
2462 |
REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B |
2463 |
REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23 |
2464 |
REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A |
2465 |
REAL*8 ZRI0B, ZRI1B |
2466 |
REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B |
2467 |
REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D |
2468 |
C ------------------------------------------------------------------ |
2469 |
C |
2470 |
C* 1. DELTA-EDDINGTON CALCULATIONS |
2471 |
C |
2472 |
100 CONTINUE |
2473 |
C |
2474 |
DO 131 JL = 1, KDLON |
2475 |
C |
2476 |
C* 1.1 SET UP THE DELTA-MODIFIED PARAMETERS |
2477 |
C |
2478 |
110 CONTINUE |
2479 |
C |
2480 |
ZFF = PGG(JL)*PGG(JL) |
2481 |
ZGP = PGG(JL)/(1.+PGG(JL)) |
2482 |
ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL) |
2483 |
ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF) |
2484 |
ZDT = 2./3. |
2485 |
ZX1 = 1.-ZWCP*ZGP |
2486 |
ZWM = 1.-ZWCP |
2487 |
ZRM2 = PRMUZ(JL) * PRMUZ(JL) |
2488 |
ZRK = SQRT(3.*ZWM*ZX1) |
2489 |
ZX2 = 4.*(1.-ZRK*ZRK*ZRM2) |
2490 |
ZRP=ZRK/ZX1 |
2491 |
ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2 |
2492 |
ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2 |
2493 |
CMAF ZARG=MIN(ZTOP/PRMUZ(JL),200.) |
2494 |
ZARG=MIN(ZTOP/PRMUZ(JL),2.0d+2) |
2495 |
ZEXMU0=EXP(-ZARG) |
2496 |
CMAF ZARG2=MIN(ZRK*ZTOP,200.) |
2497 |
ZARG2=MIN(ZRK*ZTOP,2.0d+2) |
2498 |
ZEXKP=EXP(ZARG2) |
2499 |
ZEXKM = 1./ZEXKP |
2500 |
ZXP2P = 1.+ZDT*ZRP |
2501 |
ZXM2P = 1.-ZDT*ZRP |
2502 |
ZAP2B = ZALPHA+ZDT*ZBETA |
2503 |
ZAM2B = ZALPHA-ZDT*ZBETA |
2504 |
C |
2505 |
C* 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER |
2506 |
C |
2507 |
120 CONTINUE |
2508 |
C |
2509 |
ZA11 = ZXP2P |
2510 |
ZA12 = ZXM2P |
2511 |
ZA13 = ZAP2B |
2512 |
ZA22 = ZXP2P*ZEXKP |
2513 |
ZA21 = ZXM2P*ZEXKM |
2514 |
ZA23 = ZAM2B*ZEXMU0 |
2515 |
ZDENA = ZA11 * ZA22 - ZA21 * ZA12 |
2516 |
ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA |
2517 |
ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA |
2518 |
ZRI0A = ZC1A+ZC2A-ZALPHA |
2519 |
ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA |
2520 |
PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL) |
2521 |
ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0 |
2522 |
ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0 |
2523 |
PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL) |
2524 |
C |
2525 |
C* 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER |
2526 |
C |
2527 |
130 CONTINUE |
2528 |
C |
2529 |
ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM |
2530 |
ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP |
2531 |
ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) ) |
2532 |
ZDENB = ZA11 * ZB22 - ZB21 * ZA12 |
2533 |
ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB |
2534 |
ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB |
2535 |
ZRI0C = ZC1B+ZC2B-ZALPHA |
2536 |
ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA |
2537 |
PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL) |
2538 |
ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0 |
2539 |
ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0 |
2540 |
PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL) |
2541 |
C |
2542 |
131 CONTINUE |
2543 |
RETURN |
2544 |
END |
2545 |
SUBROUTINE SWTT (KNU,KA,PU,PTR) |
2546 |
use dimens_m |
2547 |
use dimphy |
2548 |
use raddim |
2549 |
IMPLICIT none |
2550 |
C |
2551 |
C----------------------------------------------------------------------- |
2552 |
C PURPOSE. |
2553 |
C -------- |
2554 |
C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
2555 |
C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
2556 |
C INTERVALS. |
2557 |
C |
2558 |
C METHOD. |
2559 |
C ------- |
2560 |
C |
2561 |
C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
2562 |
C AND HORNER'S ALGORITHM. |
2563 |
C |
2564 |
C REFERENCE. |
2565 |
C ---------- |
2566 |
C |
2567 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
2568 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
2569 |
C |
2570 |
C AUTHOR. |
2571 |
C ------- |
2572 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
2573 |
C |
2574 |
C MODIFICATIONS. |
2575 |
C -------------- |
2576 |
C ORIGINAL : 88-12-15 |
2577 |
C----------------------------------------------------------------------- |
2578 |
C |
2579 |
C* ARGUMENTS |
2580 |
C |
2581 |
INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
2582 |
INTEGER KA ! INDEX OF THE ABSORBER |
2583 |
REAL*8 PU(KDLON) ! ABSORBER AMOUNT |
2584 |
C |
2585 |
REAL*8 PTR(KDLON) ! TRANSMISSION FUNCTION |
2586 |
C |
2587 |
C* LOCAL VARIABLES: |
2588 |
C |
2589 |
REAL*8 ZR1(KDLON), ZR2(KDLON) |
2590 |
INTEGER jl, i,j |
2591 |
C |
2592 |
C* Prescribed Data: |
2593 |
C |
2594 |
REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) |
2595 |
SAVE APAD, BPAD, D |
2596 |
DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
2597 |
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
2598 |
S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
2599 |
S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
2600 |
S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
2601 |
S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
2602 |
S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
2603 |
S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
2604 |
DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
2605 |
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
2606 |
S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
2607 |
S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
2608 |
S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
2609 |
S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
2610 |
S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
2611 |
S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
2612 |
C |
2613 |
DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
2614 |
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
2615 |
S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
2616 |
S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
2617 |
S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
2618 |
S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
2619 |
S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
2620 |
S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
2621 |
DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
2622 |
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
2623 |
S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
2624 |
S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
2625 |
S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
2626 |
S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
2627 |
S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
2628 |
S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
2629 |
c |
2630 |
DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
2631 |
DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
2632 |
C |
2633 |
C----------------------------------------------------------------------- |
2634 |
C |
2635 |
C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
2636 |
C |
2637 |
100 CONTINUE |
2638 |
C |
2639 |
DO 201 JL = 1, KDLON |
2640 |
ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL) |
2641 |
S * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL) |
2642 |
S * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL) |
2643 |
S * ( APAD(KNU,KA,7) )))))) |
2644 |
C |
2645 |
ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL) |
2646 |
S * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL) |
2647 |
S * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL) |
2648 |
S * ( BPAD(KNU,KA,7) )))))) |
2649 |
C |
2650 |
C |
2651 |
C* 2. ADD THE BACKGROUND TRANSMISSION |
2652 |
C |
2653 |
200 CONTINUE |
2654 |
C |
2655 |
C |
2656 |
PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA) |
2657 |
201 CONTINUE |
2658 |
C |
2659 |
RETURN |
2660 |
END |
2661 |
SUBROUTINE SWTT1(KNU,KABS,KIND, PU, PTR) |
2662 |
use dimens_m |
2663 |
use dimphy |
2664 |
use raddim |
2665 |
IMPLICIT none |
2666 |
C |
2667 |
C----------------------------------------------------------------------- |
2668 |
C PURPOSE. |
2669 |
C -------- |
2670 |
C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
2671 |
C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
2672 |
C INTERVALS. |
2673 |
C |
2674 |
C METHOD. |
2675 |
C ------- |
2676 |
C |
2677 |
C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
2678 |
C AND HORNER'S ALGORITHM. |
2679 |
C |
2680 |
C REFERENCE. |
2681 |
C ---------- |
2682 |
C |
2683 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
2684 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
2685 |
C |
2686 |
C AUTHOR. |
2687 |
C ------- |
2688 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
2689 |
C |
2690 |
C MODIFICATIONS. |
2691 |
C -------------- |
2692 |
C ORIGINAL : 95-01-20 |
2693 |
C----------------------------------------------------------------------- |
2694 |
C* ARGUMENTS: |
2695 |
C |
2696 |
INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
2697 |
INTEGER KABS ! NUMBER OF ABSORBERS |
2698 |
INTEGER KIND(KABS) ! INDICES OF THE ABSORBERS |
2699 |
REAL*8 PU(KDLON,KABS) ! ABSORBER AMOUNT |
2700 |
C |
2701 |
REAL*8 PTR(KDLON,KABS) ! TRANSMISSION FUNCTION |
2702 |
C |
2703 |
C* LOCAL VARIABLES: |
2704 |
C |
2705 |
REAL*8 ZR1(KDLON) |
2706 |
REAL*8 ZR2(KDLON) |
2707 |
REAL*8 ZU(KDLON) |
2708 |
INTEGER jl, ja, i, j, ia |
2709 |
C |
2710 |
C* Prescribed Data: |
2711 |
C |
2712 |
REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) |
2713 |
SAVE APAD, BPAD, D |
2714 |
DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
2715 |
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
2716 |
S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
2717 |
S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
2718 |
S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
2719 |
S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
2720 |
S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
2721 |
S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
2722 |
DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
2723 |
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
2724 |
S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
2725 |
S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
2726 |
S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
2727 |
S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
2728 |
S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
2729 |
S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
2730 |
C |
2731 |
DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
2732 |
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
2733 |
S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
2734 |
S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
2735 |
S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
2736 |
S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
2737 |
S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
2738 |
S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
2739 |
DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
2740 |
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
2741 |
S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
2742 |
S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
2743 |
S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
2744 |
S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
2745 |
S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
2746 |
S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
2747 |
c |
2748 |
DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
2749 |
DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
2750 |
C----------------------------------------------------------------------- |
2751 |
C |
2752 |
C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
2753 |
C |
2754 |
100 CONTINUE |
2755 |
C |
2756 |
DO 202 JA = 1,KABS |
2757 |
IA=KIND(JA) |
2758 |
DO 201 JL = 1, KDLON |
2759 |
ZU(JL) = PU(JL,JA) |
2760 |
ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL) |
2761 |
S * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL) |
2762 |
S * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL) |
2763 |
S * ( APAD(KNU,IA,7) )))))) |
2764 |
C |
2765 |
ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL) |
2766 |
S * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL) |
2767 |
S * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL) |
2768 |
S * ( BPAD(KNU,IA,7) )))))) |
2769 |
C |
2770 |
C |
2771 |
C* 2. ADD THE BACKGROUND TRANSMISSION |
2772 |
C |
2773 |
200 CONTINUE |
2774 |
C |
2775 |
PTR(JL,JA) = (ZR1(JL)/ZR2(JL)) * (1.-D(KNU,IA)) + D(KNU,IA) |
2776 |
201 CONTINUE |
2777 |
202 CONTINUE |
2778 |
C |
2779 |
RETURN |
2780 |
END |
2781 |
cIM ctes ds clesphys.h SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12, |
2782 |
SUBROUTINE LW( |
2783 |
. PPMB, PDP, |
2784 |
. PPSOL,PDT0,PEMIS, |
2785 |
. PTL, PTAVE, PWV, POZON, PAER, |
2786 |
. PCLDLD,PCLDLU, |
2787 |
. PVIEW, |
2788 |
. PCOLR, PCOLR0, |
2789 |
. PTOPLW,PSOLLW,PTOPLW0,PSOLLW0, |
2790 |
. psollwdown, |
2791 |
. plwup, plwdn, plwup0, plwdn0) |
2792 |
use dimens_m |
2793 |
use dimphy |
2794 |
use clesphys |
2795 |
use YOMCST |
2796 |
use raddim |
2797 |
IMPLICIT none |
2798 |
include "raddimlw.h" |
2799 |
C |
2800 |
C----------------------------------------------------------------------- |
2801 |
C METHOD. |
2802 |
C ------- |
2803 |
C |
2804 |
C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF |
2805 |
C ABSORBERS. |
2806 |
C 2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE |
2807 |
C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS. |
2808 |
C 3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON- |
2809 |
C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE |
2810 |
C BOUNDARIES. |
2811 |
C 4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. |
2812 |
C 5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES. |
2813 |
C |
2814 |
C |
2815 |
C REFERENCE. |
2816 |
C ---------- |
2817 |
C |
2818 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
2819 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
2820 |
C |
2821 |
C AUTHOR. |
2822 |
C ------- |
2823 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
2824 |
C |
2825 |
C MODIFICATIONS. |
2826 |
C -------------- |
2827 |
C ORIGINAL : 89-07-14 |
2828 |
C----------------------------------------------------------------------- |
2829 |
cIM ctes ds clesphys.h |
2830 |
c REAL*8 RCO2 ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97) |
2831 |
c REAL*8 RCH4 ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97) |
2832 |
c REAL*8 RN2O ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97) |
2833 |
c REAL*8 RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97) |
2834 |
c REAL*8 RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97) |
2835 |
REAL*8 PCLDLD(KDLON,KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER |
2836 |
REAL*8 PCLDLU(KDLON,KFLEV) ! UPWARD EFFECTIVE CLOUD COVER |
2837 |
REAL*8 PDP(KDLON,KFLEV) ! LAYER PRESSURE THICKNESS (Pa) |
2838 |
REAL*8 PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K) |
2839 |
REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
2840 |
REAL*8 PPMB(KDLON,KFLEV+1) ! HALF LEVEL PRESSURE (mb) |
2841 |
REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (Pa) |
2842 |
REAL*8 POZON(KDLON,KFLEV) ! O3 CONCENTRATION (kg/kg) |
2843 |
REAL*8 PTL(KDLON,KFLEV+1) ! HALF LEVEL TEMPERATURE (K) |
2844 |
REAL*8 PAER(KDLON,KFLEV,5) ! OPTICAL THICKNESS OF THE AEROSOLS |
2845 |
REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K) |
2846 |
REAL*8 PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE |
2847 |
REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (kg/kg) |
2848 |
C |
2849 |
REAL*8 PCOLR(KDLON,KFLEV) ! LONG-WAVE TENDENCY (K/day) |
2850 |
REAL*8 PCOLR0(KDLON,KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky |
2851 |
REAL*8 PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A. |
2852 |
REAL*8 PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE |
2853 |
REAL*8 PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY) |
2854 |
REAL*8 PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY) |
2855 |
c Rajout LF |
2856 |
real*8 psollwdown(kdlon) ! LONGWAVE downwards flux at surface |
2857 |
cIM |
2858 |
REAL*8 plwup(KDLON,KFLEV+1) ! LW up total sky |
2859 |
REAL*8 plwup0(KDLON,KFLEV+1) ! LW up clear sky |
2860 |
REAL*8 plwdn(KDLON,KFLEV+1) ! LW down total sky |
2861 |
REAL*8 plwdn0(KDLON,KFLEV+1) ! LW down clear sky |
2862 |
C------------------------------------------------------------------------- |
2863 |
REAL*8 ZABCU(KDLON,NUA,3*KFLEV+1) |
2864 |
REAL*8 ZOZ(KDLON,KFLEV) |
2865 |
c |
2866 |
REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down) |
2867 |
REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
2868 |
REAL*8 ZBINT(KDLON,KFLEV+1) ! Intermediate variable |
2869 |
REAL*8 ZBSUI(KDLON) ! Intermediate variable |
2870 |
REAL*8 ZCTS(KDLON,KFLEV) ! Intermediate variable |
2871 |
REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1) ! Intermediate variable |
2872 |
SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB |
2873 |
c |
2874 |
INTEGER ilim, i, k, kpl1 |
2875 |
C |
2876 |
INTEGER lw0pas ! Every lw0pas steps, clear-sky is done |
2877 |
PARAMETER (lw0pas=1) |
2878 |
INTEGER lwpas ! Every lwpas steps, cloudy-sky is done |
2879 |
PARAMETER (lwpas=1) |
2880 |
c |
2881 |
INTEGER itaplw0, itaplw |
2882 |
LOGICAL appel1er |
2883 |
SAVE appel1er, itaplw0, itaplw |
2884 |
DATA appel1er /.TRUE./ |
2885 |
DATA itaplw0,itaplw /0,0/ |
2886 |
C ------------------------------------------------------------------ |
2887 |
IF (appel1er) THEN |
2888 |
PRINT*, "LW clear-sky calling frequency: ", lw0pas |
2889 |
PRINT*, "LW cloudy-sky calling frequency: ", lwpas |
2890 |
PRINT*, " In general, they should be 1" |
2891 |
appel1er=.FALSE. |
2892 |
ENDIF |
2893 |
C |
2894 |
IF (MOD(itaplw0,lw0pas).EQ.0) THEN |
2895 |
DO k = 1, KFLEV ! convertir ozone de kg/kg en pa/pa |
2896 |
DO i = 1, KDLON |
2897 |
c convertir ozone de kg/kg en pa (modif MPL 100505) |
2898 |
ZOZ(i,k) = POZON(i,k)*PDP(i,k) * RMD/RMO3 |
2899 |
c print *,'LW: ZOZ*10**6=',ZOZ(i,k)*1000000. |
2900 |
ENDDO |
2901 |
ENDDO |
2902 |
cIM ctes ds clesphys.h CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12, |
2903 |
CALL LWU( |
2904 |
S PAER,PDP,PPMB,PPSOL,ZOZ,PTAVE,PVIEW,PWV,ZABCU) |
2905 |
CALL LWBV(ILIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,ZABCU, |
2906 |
S ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB) |
2907 |
itaplw0 = 0 |
2908 |
ENDIF |
2909 |
itaplw0 = itaplw0 + 1 |
2910 |
C |
2911 |
IF (MOD(itaplw,lwpas).EQ.0) THEN |
2912 |
CALL LWC(ILIM,PCLDLD,PCLDLU,PEMIS, |
2913 |
S ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB, |
2914 |
S ZFLUX) |
2915 |
itaplw = 0 |
2916 |
ENDIF |
2917 |
itaplw = itaplw + 1 |
2918 |
C |
2919 |
DO k = 1, KFLEV |
2920 |
kpl1 = k+1 |
2921 |
DO i = 1, KDLON |
2922 |
PCOLR(i,k) = ZFLUX(i,1,kpl1)+ZFLUX(i,2,kpl1) |
2923 |
. - ZFLUX(i,1,k)- ZFLUX(i,2,k) |
2924 |
PCOLR(i,k) = PCOLR(i,k) * RDAY*RG/RCPD / PDP(i,k) |
2925 |
PCOLR0(i,k) = ZFLUC(i,1,kpl1)+ZFLUC(i,2,kpl1) |
2926 |
. - ZFLUC(i,1,k)- ZFLUC(i,2,k) |
2927 |
PCOLR0(i,k) = PCOLR0(i,k) * RDAY*RG/RCPD / PDP(i,k) |
2928 |
ENDDO |
2929 |
ENDDO |
2930 |
DO i = 1, KDLON |
2931 |
PSOLLW(i) = -ZFLUX(i,1,1)-ZFLUX(i,2,1) |
2932 |
PTOPLW(i) = ZFLUX(i,1,KFLEV+1) + ZFLUX(i,2,KFLEV+1) |
2933 |
c |
2934 |
PSOLLW0(i) = -ZFLUC(i,1,1)-ZFLUC(i,2,1) |
2935 |
PTOPLW0(i) = ZFLUC(i,1,KFLEV+1) + ZFLUC(i,2,KFLEV+1) |
2936 |
psollwdown(i) = -ZFLUX(i,2,1) |
2937 |
c |
2938 |
cIM attention aux signes !; LWtop >0, LWdn < 0 |
2939 |
DO k = 1, KFLEV+1 |
2940 |
plwup(i,k) = ZFLUX(i,1,k) |
2941 |
plwup0(i,k) = ZFLUC(i,1,k) |
2942 |
plwdn(i,k) = ZFLUX(i,2,k) |
2943 |
plwdn0(i,k) = ZFLUC(i,2,k) |
2944 |
ENDDO |
2945 |
ENDDO |
2946 |
C ------------------------------------------------------------------ |
2947 |
RETURN |
2948 |
END |
2949 |
cIM ctes ds clesphys.h SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12, |
2950 |
SUBROUTINE LWU( |
2951 |
S PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV, |
2952 |
S PABCU) |
2953 |
use dimens_m |
2954 |
use dimphy |
2955 |
use clesphys |
2956 |
use YOMCST |
2957 |
use raddim |
2958 |
use radepsi |
2959 |
use radopt |
2960 |
IMPLICIT none |
2961 |
include "raddimlw.h" |
2962 |
C |
2963 |
C PURPOSE. |
2964 |
C -------- |
2965 |
C COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND |
2966 |
C TEMPERATURE EFFECTS |
2967 |
C |
2968 |
C METHOD. |
2969 |
C ------- |
2970 |
C |
2971 |
C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF |
2972 |
C ABSORBERS. |
2973 |
C |
2974 |
C |
2975 |
C REFERENCE. |
2976 |
C ---------- |
2977 |
C |
2978 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
2979 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
2980 |
C |
2981 |
C AUTHOR. |
2982 |
C ------- |
2983 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
2984 |
C |
2985 |
C MODIFICATIONS. |
2986 |
C -------------- |
2987 |
C ORIGINAL : 89-07-14 |
2988 |
C Voigt lines (loop 404 modified) - JJM & PhD - 01/96 |
2989 |
C----------------------------------------------------------------------- |
2990 |
C* ARGUMENTS: |
2991 |
cIM ctes ds clesphys.h |
2992 |
c REAL*8 RCO2 |
2993 |
c REAL*8 RCH4, RN2O, RCFC11, RCFC12 |
2994 |
REAL*8 PAER(KDLON,KFLEV,5) |
2995 |
REAL*8 PDP(KDLON,KFLEV) |
2996 |
REAL*8 PPMB(KDLON,KFLEV+1) |
2997 |
REAL*8 PPSOL(KDLON) |
2998 |
REAL*8 POZ(KDLON,KFLEV) |
2999 |
REAL*8 PTAVE(KDLON,KFLEV) |
3000 |
REAL*8 PVIEW(KDLON) |
3001 |
REAL*8 PWV(KDLON,KFLEV) |
3002 |
C |
3003 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS |
3004 |
C |
3005 |
C----------------------------------------------------------------------- |
3006 |
C* LOCAL VARIABLES: |
3007 |
REAL*8 ZABLY(KDLON,NUA,3*KFLEV+1) |
3008 |
REAL*8 ZDUC(KDLON,3*KFLEV+1) |
3009 |
REAL*8 ZPHIO(KDLON) |
3010 |
REAL*8 ZPSC2(KDLON) |
3011 |
REAL*8 ZPSC3(KDLON) |
3012 |
REAL*8 ZPSH1(KDLON) |
3013 |
REAL*8 ZPSH2(KDLON) |
3014 |
REAL*8 ZPSH3(KDLON) |
3015 |
REAL*8 ZPSH4(KDLON) |
3016 |
REAL*8 ZPSH5(KDLON) |
3017 |
REAL*8 ZPSH6(KDLON) |
3018 |
REAL*8 ZPSIO(KDLON) |
3019 |
REAL*8 ZTCON(KDLON) |
3020 |
REAL*8 ZPHM6(KDLON) |
3021 |
REAL*8 ZPSM6(KDLON) |
3022 |
REAL*8 ZPHN6(KDLON) |
3023 |
REAL*8 ZPSN6(KDLON) |
3024 |
REAL*8 ZSSIG(KDLON,3*KFLEV+1) |
3025 |
REAL*8 ZTAVI(KDLON) |
3026 |
REAL*8 ZUAER(KDLON,Ninter) |
3027 |
REAL*8 ZXOZ(KDLON) |
3028 |
REAL*8 ZXWV(KDLON) |
3029 |
C |
3030 |
INTEGER jl, jk, jkj, jkjr, jkjp, ig1 |
3031 |
INTEGER jki, jkip1, ja, jj |
3032 |
INTEGER jkl, jkp1, jkk, jkjpn |
3033 |
INTEGER jae1, jae2, jae3, jae, jjpn |
3034 |
INTEGER ir, jc, jcp1 |
3035 |
REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup |
3036 |
REAL*8 zfppw, ztx, ztx2, zzably |
3037 |
REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3 |
3038 |
REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6 |
3039 |
REAL*8 zcac8, zcbc8 |
3040 |
REAL*8 zalup, zdiff |
3041 |
c |
3042 |
REAL*8 PVGCO2, PVGH2O, PVGO3 |
3043 |
C |
3044 |
REAL*8 R10E ! DECIMAL/NATURAL LOG.FACTOR |
3045 |
PARAMETER (R10E=0.4342945) |
3046 |
c |
3047 |
c Used Data Block: |
3048 |
c |
3049 |
REAL*8 TREF |
3050 |
SAVE TREF |
3051 |
REAL*8 RT1(2) |
3052 |
SAVE RT1 |
3053 |
REAL*8 RAER(5,5) |
3054 |
SAVE RAER |
3055 |
REAL*8 AT(8,3), BT(8,3) |
3056 |
SAVE AT, BT |
3057 |
REAL*8 OCT(4) |
3058 |
SAVE OCT |
3059 |
DATA TREF /250.0/ |
3060 |
DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 / |
3061 |
DATA RAER / .038520, .037196, .040532, .054934, .038520 |
3062 |
1 , .12613 , .18313 , .10357 , .064106, .126130 |
3063 |
2 , .012579, .013649, .018652, .025181, .012579 |
3064 |
3 , .011890, .016142, .021105, .028908, .011890 |
3065 |
4 , .013792, .026810, .052203, .066338, .013792 / |
3066 |
DATA (AT(1,IR),IR=1,3) / |
3067 |
S 0.298199E-02,-.394023E-03,0.319566E-04 / |
3068 |
DATA (BT(1,IR),IR=1,3) / |
3069 |
S-0.106432E-04,0.660324E-06,0.174356E-06 / |
3070 |
DATA (AT(2,IR),IR=1,3) / |
3071 |
S 0.143676E-01,0.366501E-02,-.160822E-02 / |
3072 |
DATA (BT(2,IR),IR=1,3) / |
3073 |
S-0.553979E-04,-.101701E-04,0.920868E-05 / |
3074 |
DATA (AT(3,IR),IR=1,3) / |
3075 |
S 0.197861E-01,0.315541E-02,-.174547E-02 / |
3076 |
DATA (BT(3,IR),IR=1,3) / |
3077 |
S-0.877012E-04,0.513302E-04,0.523138E-06 / |
3078 |
DATA (AT(4,IR),IR=1,3) / |
3079 |
S 0.289560E-01,-.208807E-02,-.121943E-02 / |
3080 |
DATA (BT(4,IR),IR=1,3) / |
3081 |
S-0.165960E-03,0.157704E-03,-.146427E-04 / |
3082 |
DATA (AT(5,IR),IR=1,3) / |
3083 |
S 0.103800E-01,0.436296E-02,-.161431E-02 / |
3084 |
DATA (BT(5,IR),IR=1,3) / |
3085 |
S -.276744E-04,-.327381E-04,0.127646E-04 / |
3086 |
DATA (AT(6,IR),IR=1,3) / |
3087 |
S 0.868859E-02,-.972752E-03,0.000000E-00 / |
3088 |
DATA (BT(6,IR),IR=1,3) / |
3089 |
S -.278412E-04,-.713940E-06,0.117469E-05 / |
3090 |
DATA (AT(7,IR),IR=1,3) / |
3091 |
S 0.250073E-03,0.455875E-03,0.109242E-03 / |
3092 |
DATA (BT(7,IR),IR=1,3) / |
3093 |
S 0.199846E-05,-.216313E-05,0.175991E-06 / |
3094 |
DATA (AT(8,IR),IR=1,3) / |
3095 |
S 0.307423E-01,0.110879E-02,-.322172E-03 / |
3096 |
DATA (BT(8,IR),IR=1,3) / |
3097 |
S-0.108482E-03,0.258096E-05,-.814575E-06 / |
3098 |
c |
3099 |
DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/ |
3100 |
C----------------------------------------------------------------------- |
3101 |
c |
3102 |
IF (LEVOIGT) THEN |
3103 |
PVGCO2= 60. |
3104 |
PVGH2O= 30. |
3105 |
PVGO3 =400. |
3106 |
ELSE |
3107 |
PVGCO2= 0. |
3108 |
PVGH2O= 0. |
3109 |
PVGO3 = 0. |
3110 |
ENDIF |
3111 |
C |
3112 |
C |
3113 |
C* 2. PRESSURE OVER GAUSS SUB-LEVELS |
3114 |
C ------------------------------ |
3115 |
C |
3116 |
200 CONTINUE |
3117 |
C |
3118 |
DO 201 JL = 1, KDLON |
3119 |
ZSSIG(JL, 1 ) = PPMB(JL,1) * 100. |
3120 |
201 CONTINUE |
3121 |
C |
3122 |
DO 206 JK = 1 , KFLEV |
3123 |
JKJ=(JK-1)*NG1P1+1 |
3124 |
JKJR = JKJ |
3125 |
JKJP = JKJ + NG1P1 |
3126 |
DO 203 JL = 1, KDLON |
3127 |
ZSSIG(JL,JKJP)=PPMB(JL,JK+1)* 100. |
3128 |
203 CONTINUE |
3129 |
DO 205 IG1=1,NG1 |
3130 |
JKJ=JKJ+1 |
3131 |
DO 204 JL = 1, KDLON |
3132 |
ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5 |
3133 |
S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5 |
3134 |
204 CONTINUE |
3135 |
205 CONTINUE |
3136 |
206 CONTINUE |
3137 |
C |
3138 |
C----------------------------------------------------------------------- |
3139 |
C |
3140 |
C |
3141 |
C* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS |
3142 |
C -------------------------------------------------- |
3143 |
C |
3144 |
400 CONTINUE |
3145 |
C |
3146 |
DO 402 JKI=1,3*KFLEV |
3147 |
JKIP1=JKI+1 |
3148 |
DO 401 JL = 1, KDLON |
3149 |
ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5 |
3150 |
ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1)) |
3151 |
S /(10.*RG) |
3152 |
401 CONTINUE |
3153 |
402 CONTINUE |
3154 |
C |
3155 |
DO 406 JK = 1 , KFLEV |
3156 |
JKP1=JK+1 |
3157 |
JKL = KFLEV+1 - JK |
3158 |
DO 403 JL = 1, KDLON |
3159 |
ZXWV(JL) = MAX (PWV(JL,JK) , ZEPSCQ ) |
3160 |
ZXOZ(JL) = MAX (POZ(JL,JK) / PDP(JL,JK) , ZEPSCO ) |
3161 |
403 CONTINUE |
3162 |
JKJ=(JK-1)*NG1P1+1 |
3163 |
JKJPN=JKJ+NG1 |
3164 |
DO 405 JKK=JKJ,JKJPN |
3165 |
DO 404 JL = 1, KDLON |
3166 |
ZDPM = ZABLY(JL,3,JKK) |
3167 |
ZUPM = ZABLY(JL,5,JKK) * ZDPM / 101325. |
3168 |
ZUPMCO2 = ( ZABLY(JL,5,JKK) + PVGCO2 ) * ZDPM / 101325. |
3169 |
ZUPMH2O = ( ZABLY(JL,5,JKK) + PVGH2O ) * ZDPM / 101325. |
3170 |
ZUPMO3 = ( ZABLY(JL,5,JKK) + PVGO3 ) * ZDPM / 101325. |
3171 |
ZDUC(JL,JKK) = ZDPM |
3172 |
ZABLY(JL,12,JKK) = ZXOZ(JL) * ZDPM |
3173 |
ZABLY(JL,13,JKK) = ZXOZ(JL) * ZUPMO3 |
3174 |
ZU6 = ZXWV(JL) * ZUPM |
3175 |
ZFPPW = 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL)) |
3176 |
ZABLY(JL,6,JKK) = ZXWV(JL) * ZUPMH2O |
3177 |
ZABLY(JL,11,JKK) = ZU6 * ZFPPW |
3178 |
ZABLY(JL,10,JKK) = ZU6 * (1.-ZFPPW) |
3179 |
ZABLY(JL,9,JKK) = RCO2 * ZUPMCO2 |
3180 |
ZABLY(JL,8,JKK) = RCO2 * ZDPM |
3181 |
404 CONTINUE |
3182 |
405 CONTINUE |
3183 |
406 CONTINUE |
3184 |
C |
3185 |
C----------------------------------------------------------------------- |
3186 |
C |
3187 |
C |
3188 |
C* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE |
3189 |
C -------------------------------------------------- |
3190 |
C |
3191 |
500 CONTINUE |
3192 |
C |
3193 |
DO 502 JA = 1, NUA |
3194 |
DO 501 JL = 1, KDLON |
3195 |
PABCU(JL,JA,3*KFLEV+1) = 0. |
3196 |
501 CONTINUE |
3197 |
502 CONTINUE |
3198 |
C |
3199 |
DO 529 JK = 1 , KFLEV |
3200 |
JJ=(JK-1)*NG1P1+1 |
3201 |
JJPN=JJ+NG1 |
3202 |
JKL=KFLEV+1-JK |
3203 |
C |
3204 |
C |
3205 |
C* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE |
3206 |
C -------------------------------------------------- |
3207 |
C |
3208 |
510 CONTINUE |
3209 |
C |
3210 |
JAE1=3*KFLEV+1-JJ |
3211 |
JAE2=3*KFLEV+1-(JJ+1) |
3212 |
JAE3=3*KFLEV+1-JJPN |
3213 |
DO 512 JAE=1,5 |
3214 |
DO 511 JL = 1, KDLON |
3215 |
ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL,JKL,1) |
3216 |
S +RAER(JAE,2)*PAER(JL,JKL,2)+RAER(JAE,3)*PAER(JL,JKL,3) |
3217 |
S +RAER(JAE,4)*PAER(JL,JKL,4)+RAER(JAE,5)*PAER(JL,JKL,5)) |
3218 |
S /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3)) |
3219 |
511 CONTINUE |
3220 |
512 CONTINUE |
3221 |
C |
3222 |
C |
3223 |
C |
3224 |
C* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS |
3225 |
C -------------------------------------------------- |
3226 |
C |
3227 |
520 CONTINUE |
3228 |
C |
3229 |
DO 521 JL = 1, KDLON |
3230 |
ZTAVI(JL)=PTAVE(JL,JKL) |
3231 |
ZTCON(JL)=EXP(6.08*(296./ZTAVI(JL)-1.)) |
3232 |
ZTX=ZTAVI(JL)-TREF |
3233 |
ZTX2=ZTX*ZTX |
3234 |
ZZABLY = ZABLY(JL,6,JAE1)+ZABLY(JL,6,JAE2)+ZABLY(JL,6,JAE3) |
3235 |
CMAF ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.), 6.0) |
3236 |
ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.d+0), 6.d+0) |
3237 |
ZCAH1=AT(1,1)+ZUP*(AT(1,2)+ZUP*(AT(1,3))) |
3238 |
ZCBH1=BT(1,1)+ZUP*(BT(1,2)+ZUP*(BT(1,3))) |
3239 |
ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 ) |
3240 |
ZCAH2=AT(2,1)+ZUP*(AT(2,2)+ZUP*(AT(2,3))) |
3241 |
ZCBH2=BT(2,1)+ZUP*(BT(2,2)+ZUP*(BT(2,3))) |
3242 |
ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 ) |
3243 |
ZCAH3=AT(3,1)+ZUP*(AT(3,2)+ZUP*(AT(3,3))) |
3244 |
ZCBH3=BT(3,1)+ZUP*(BT(3,2)+ZUP*(BT(3,3))) |
3245 |
ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 ) |
3246 |
ZCAH4=AT(4,1)+ZUP*(AT(4,2)+ZUP*(AT(4,3))) |
3247 |
ZCBH4=BT(4,1)+ZUP*(BT(4,2)+ZUP*(BT(4,3))) |
3248 |
ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 ) |
3249 |
ZCAH5=AT(5,1)+ZUP*(AT(5,2)+ZUP*(AT(5,3))) |
3250 |
ZCBH5=BT(5,1)+ZUP*(BT(5,2)+ZUP*(BT(5,3))) |
3251 |
ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 ) |
3252 |
ZCAH6=AT(6,1)+ZUP*(AT(6,2)+ZUP*(AT(6,3))) |
3253 |
ZCBH6=BT(6,1)+ZUP*(BT(6,2)+ZUP*(BT(6,3))) |
3254 |
ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 ) |
3255 |
ZPHM6(JL)=EXP(-5.81E-4 * ZTX - 1.13E-6 * ZTX2 ) |
3256 |
ZPSM6(JL)=EXP(-5.57E-4 * ZTX - 3.30E-6 * ZTX2 ) |
3257 |
ZPHN6(JL)=EXP(-3.46E-5 * ZTX + 2.05E-7 * ZTX2 ) |
3258 |
ZPSN6(JL)=EXP( 3.70E-3 * ZTX - 2.30E-6 * ZTX2 ) |
3259 |
521 CONTINUE |
3260 |
C |
3261 |
DO 522 JL = 1, KDLON |
3262 |
ZTAVI(JL)=PTAVE(JL,JKL) |
3263 |
ZTX=ZTAVI(JL)-TREF |
3264 |
ZTX2=ZTX*ZTX |
3265 |
ZZABLY = ZABLY(JL,9,JAE1)+ZABLY(JL,9,JAE2)+ZABLY(JL,9,JAE3) |
3266 |
ZALUP = R10E * LOG ( ZZABLY ) |
3267 |
CMAF ZUP = MAX( 0.0 , 5.0 + 0.5 * ZALUP ) |
3268 |
ZUP = MAX( 0.d+0 , 5.0 + 0.5 * ZALUP ) |
3269 |
ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP |
3270 |
ZCAC8=AT(8,1)+ZUP*(AT(8,2)+ZUP*(AT(8,3))) |
3271 |
ZCBC8=BT(8,1)+ZUP*(BT(8,2)+ZUP*(BT(8,3))) |
3272 |
ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 ) |
3273 |
ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2) |
3274 |
ZPSIO(JL) = EXP( 2.* (OCT(3)*ZTX+OCT(4)*ZTX2)) |
3275 |
522 CONTINUE |
3276 |
C |
3277 |
DO 524 JKK=JJ,JJPN |
3278 |
JC=3*KFLEV+1-JKK |
3279 |
JCP1=JC+1 |
3280 |
DO 523 JL = 1, KDLON |
3281 |
ZDIFF = PVIEW(JL) |
3282 |
PABCU(JL,10,JC)=PABCU(JL,10,JCP1) |
3283 |
S +ZABLY(JL,10,JC) *ZDIFF |
3284 |
PABCU(JL,11,JC)=PABCU(JL,11,JCP1) |
3285 |
S +ZABLY(JL,11,JC)*ZTCON(JL)*ZDIFF |
3286 |
C |
3287 |
PABCU(JL,12,JC)=PABCU(JL,12,JCP1) |
3288 |
S +ZABLY(JL,12,JC)*ZPHIO(JL)*ZDIFF |
3289 |
PABCU(JL,13,JC)=PABCU(JL,13,JCP1) |
3290 |
S +ZABLY(JL,13,JC)*ZPSIO(JL)*ZDIFF |
3291 |
C |
3292 |
PABCU(JL,7,JC)=PABCU(JL,7,JCP1) |
3293 |
S +ZABLY(JL,9,JC)*ZPSC2(JL)*ZDIFF |
3294 |
PABCU(JL,8,JC)=PABCU(JL,8,JCP1) |
3295 |
S +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF |
3296 |
PABCU(JL,9,JC)=PABCU(JL,9,JCP1) |
3297 |
S +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF |
3298 |
C |
3299 |
PABCU(JL,1,JC)=PABCU(JL,1,JCP1) |
3300 |
S +ZABLY(JL,6,JC)*ZPSH1(JL)*ZDIFF |
3301 |
PABCU(JL,2,JC)=PABCU(JL,2,JCP1) |
3302 |
S +ZABLY(JL,6,JC)*ZPSH2(JL)*ZDIFF |
3303 |
PABCU(JL,3,JC)=PABCU(JL,3,JCP1) |
3304 |
S +ZABLY(JL,6,JC)*ZPSH5(JL)*ZDIFF |
3305 |
PABCU(JL,4,JC)=PABCU(JL,4,JCP1) |
3306 |
S +ZABLY(JL,6,JC)*ZPSH3(JL)*ZDIFF |
3307 |
PABCU(JL,5,JC)=PABCU(JL,5,JCP1) |
3308 |
S +ZABLY(JL,6,JC)*ZPSH4(JL)*ZDIFF |
3309 |
PABCU(JL,6,JC)=PABCU(JL,6,JCP1) |
3310 |
S +ZABLY(JL,6,JC)*ZPSH6(JL)*ZDIFF |
3311 |
C |
3312 |
PABCU(JL,14,JC)=PABCU(JL,14,JCP1) |
3313 |
S +ZUAER(JL,1) *ZDUC(JL,JC)*ZDIFF |
3314 |
PABCU(JL,15,JC)=PABCU(JL,15,JCP1) |
3315 |
S +ZUAER(JL,2) *ZDUC(JL,JC)*ZDIFF |
3316 |
PABCU(JL,16,JC)=PABCU(JL,16,JCP1) |
3317 |
S +ZUAER(JL,3) *ZDUC(JL,JC)*ZDIFF |
3318 |
PABCU(JL,17,JC)=PABCU(JL,17,JCP1) |
3319 |
S +ZUAER(JL,4) *ZDUC(JL,JC)*ZDIFF |
3320 |
PABCU(JL,18,JC)=PABCU(JL,18,JCP1) |
3321 |
S +ZUAER(JL,5) *ZDUC(JL,JC)*ZDIFF |
3322 |
C |
3323 |
PABCU(JL,19,JC)=PABCU(JL,19,JCP1) |
3324 |
S +ZABLY(JL,8,JC)*RCH4/RCO2*ZPHM6(JL)*ZDIFF |
3325 |
PABCU(JL,20,JC)=PABCU(JL,20,JCP1) |
3326 |
S +ZABLY(JL,9,JC)*RCH4/RCO2*ZPSM6(JL)*ZDIFF |
3327 |
PABCU(JL,21,JC)=PABCU(JL,21,JCP1) |
3328 |
S +ZABLY(JL,8,JC)*RN2O/RCO2*ZPHN6(JL)*ZDIFF |
3329 |
PABCU(JL,22,JC)=PABCU(JL,22,JCP1) |
3330 |
S +ZABLY(JL,9,JC)*RN2O/RCO2*ZPSN6(JL)*ZDIFF |
3331 |
C |
3332 |
PABCU(JL,23,JC)=PABCU(JL,23,JCP1) |
3333 |
S +ZABLY(JL,8,JC)*RCFC11/RCO2 *ZDIFF |
3334 |
PABCU(JL,24,JC)=PABCU(JL,24,JCP1) |
3335 |
S +ZABLY(JL,8,JC)*RCFC12/RCO2 *ZDIFF |
3336 |
523 CONTINUE |
3337 |
524 CONTINUE |
3338 |
C |
3339 |
529 CONTINUE |
3340 |
C |
3341 |
C |
3342 |
RETURN |
3343 |
END |
3344 |
SUBROUTINE LWBV(KLIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,PABCU, |
3345 |
S PFLUC,PBINT,PBSUI,PCTS,PCNTRB) |
3346 |
use dimens_m |
3347 |
use dimphy |
3348 |
use YOMCST |
3349 |
use raddim |
3350 |
IMPLICIT none |
3351 |
include "raddimlw.h" |
3352 |
C |
3353 |
C PURPOSE. |
3354 |
C -------- |
3355 |
C TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE |
3356 |
C VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY |
3357 |
C SAVING |
3358 |
C |
3359 |
C METHOD. |
3360 |
C ------- |
3361 |
C |
3362 |
C 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE |
3363 |
C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS. |
3364 |
C 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON- |
3365 |
C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE |
3366 |
C BOUNDARIES. |
3367 |
C 3. COMPUTES THE CLEAR-SKY COOLING RATES. |
3368 |
C |
3369 |
C REFERENCE. |
3370 |
C ---------- |
3371 |
C |
3372 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
3373 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
3374 |
C |
3375 |
C AUTHOR. |
3376 |
C ------- |
3377 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
3378 |
C |
3379 |
C MODIFICATIONS. |
3380 |
C -------------- |
3381 |
C ORIGINAL : 89-07-14 |
3382 |
C MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE |
3383 |
C MEMORY) |
3384 |
C----------------------------------------------------------------------- |
3385 |
C* ARGUMENTS: |
3386 |
INTEGER KLIM |
3387 |
C |
3388 |
REAL*8 PDP(KDLON,KFLEV) |
3389 |
REAL*8 PDT0(KDLON) |
3390 |
REAL*8 PEMIS(KDLON) |
3391 |
REAL*8 PPMB(KDLON,KFLEV+1) |
3392 |
REAL*8 PTL(KDLON,KFLEV+1) |
3393 |
REAL*8 PTAVE(KDLON,KFLEV) |
3394 |
C |
3395 |
REAL*8 PFLUC(KDLON,2,KFLEV+1) |
3396 |
C |
3397 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) |
3398 |
REAL*8 PBINT(KDLON,KFLEV+1) |
3399 |
REAL*8 PBSUI(KDLON) |
3400 |
REAL*8 PCTS(KDLON,KFLEV) |
3401 |
REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) |
3402 |
C |
3403 |
C------------------------------------------------------------------------- |
3404 |
C |
3405 |
C* LOCAL VARIABLES: |
3406 |
REAL*8 ZB(KDLON,Ninter,KFLEV+1) |
3407 |
REAL*8 ZBSUR(KDLON,Ninter) |
3408 |
REAL*8 ZBTOP(KDLON,Ninter) |
3409 |
REAL*8 ZDBSL(KDLON,Ninter,KFLEV*2) |
3410 |
REAL*8 ZGA(KDLON,8,2,KFLEV) |
3411 |
REAL*8 ZGB(KDLON,8,2,KFLEV) |
3412 |
REAL*8 ZGASUR(KDLON,8,2) |
3413 |
REAL*8 ZGBSUR(KDLON,8,2) |
3414 |
REAL*8 ZGATOP(KDLON,8,2) |
3415 |
REAL*8 ZGBTOP(KDLON,8,2) |
3416 |
C |
3417 |
INTEGER nuaer, ntraer |
3418 |
C ------------------------------------------------------------------ |
3419 |
C* COMPUTES PLANCK FUNCTIONS: |
3420 |
CALL LWB(PDT0,PTAVE,PTL, |
3421 |
S ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL, |
3422 |
S ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP) |
3423 |
C ------------------------------------------------------------------ |
3424 |
C* PERFORMS THE VERTICAL INTEGRATION: |
3425 |
NUAER = NUA |
3426 |
NTRAER = NTRA |
3427 |
CALL LWV(NUAER,NTRAER, KLIM |
3428 |
R , PABCU,ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL,PEMIS,PPMB,PTAVE |
3429 |
R , ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP |
3430 |
S , PCNTRB,PCTS,PFLUC) |
3431 |
C ------------------------------------------------------------------ |
3432 |
RETURN |
3433 |
END |
3434 |
SUBROUTINE LWC(KLIM,PCLDLD,PCLDLU,PEMIS,PFLUC, |
3435 |
R PBINT,PBSUIN,PCTS,PCNTRB, |
3436 |
S PFLUX) |
3437 |
use dimens_m |
3438 |
use dimphy |
3439 |
use raddim |
3440 |
use radepsi |
3441 |
use radopt |
3442 |
IMPLICIT none |
3443 |
C |
3444 |
C PURPOSE. |
3445 |
C -------- |
3446 |
C INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR |
3447 |
C RADIANCES |
3448 |
C |
3449 |
C EXPLICIT ARGUMENTS : |
3450 |
C -------------------- |
3451 |
C ==== INPUTS === |
3452 |
C PBINT : (KDLON,0:KFLEV) ; HALF LEVEL PLANCK FUNCTION |
3453 |
C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION |
3454 |
C PCLDLD : (KDLON,KFLEV) ; DOWNWARD EFFECTIVE CLOUD FRACTION |
3455 |
C PCLDLU : (KDLON,KFLEV) ; UPWARD EFFECTIVE CLOUD FRACTION |
3456 |
C PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE |
3457 |
C PCTS : (KDLON,KFLEV) ; CLEAR-SKY LAYER COOLING-TO-SPACE |
3458 |
C PEMIS : (KDLON) ; SURFACE EMISSIVITY |
3459 |
C PFLUC |
3460 |
C ==== OUTPUTS === |
3461 |
C PFLUX(KDLON,2,KFLEV) ; RADIATIVE FLUXES : |
3462 |
C 1 ==> UPWARD FLUX TOTAL |
3463 |
C 2 ==> DOWNWARD FLUX TOTAL |
3464 |
C |
3465 |
C METHOD. |
3466 |
C ------- |
3467 |
C |
3468 |
C 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES |
3469 |
C 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER |
3470 |
C 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED |
3471 |
C CLOUDS |
3472 |
C |
3473 |
C REFERENCE. |
3474 |
C ---------- |
3475 |
C |
3476 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
3477 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
3478 |
C |
3479 |
C AUTHOR. |
3480 |
C ------- |
3481 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
3482 |
C |
3483 |
C MODIFICATIONS. |
3484 |
C -------------- |
3485 |
C ORIGINAL : 89-07-14 |
3486 |
C Voigt lines (loop 231 to 233) - JJM & PhD - 01/96 |
3487 |
C----------------------------------------------------------------------- |
3488 |
C* ARGUMENTS: |
3489 |
INTEGER klim |
3490 |
REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
3491 |
REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION |
3492 |
REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
3493 |
REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE |
3494 |
REAL*8 PCTS(KDLON,KFLEV) ! CLEAR-SKY LAYER COOLING-TO-SPACE |
3495 |
c |
3496 |
REAL*8 PCLDLD(KDLON,KFLEV) |
3497 |
REAL*8 PCLDLU(KDLON,KFLEV) |
3498 |
REAL*8 PEMIS(KDLON) |
3499 |
C |
3500 |
REAL*8 PFLUX(KDLON,2,KFLEV+1) |
3501 |
C----------------------------------------------------------------------- |
3502 |
C* LOCAL VARIABLES: |
3503 |
INTEGER IMX(KDLON), IMXP(KDLON) |
3504 |
C |
3505 |
REAL*8 ZCLEAR(KDLON),ZCLOUD(KDLON),ZDNF(KDLON,KFLEV+1,KFLEV+1) |
3506 |
S , ZFD(KDLON), ZFN10(KDLON), ZFU(KDLON) |
3507 |
S , ZUPF(KDLON,KFLEV+1,KFLEV+1) |
3508 |
REAL*8 ZCLM(KDLON,KFLEV+1,KFLEV+1) |
3509 |
C |
3510 |
INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1 |
3511 |
INTEGER jk1, jk2, jkc, jkcp1, jcloud |
3512 |
INTEGER imxm1, imxp1 |
3513 |
REAL*8 zcfrac |
3514 |
C ------------------------------------------------------------------ |
3515 |
C |
3516 |
C* 1. INITIALIZATION |
3517 |
C -------------- |
3518 |
C |
3519 |
100 CONTINUE |
3520 |
C |
3521 |
IMAXC = 0 |
3522 |
C |
3523 |
DO 101 JL = 1, KDLON |
3524 |
IMX(JL)=0 |
3525 |
IMXP(JL)=0 |
3526 |
ZCLOUD(JL) = 0. |
3527 |
101 CONTINUE |
3528 |
C |
3529 |
C* 1.1 SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD |
3530 |
C ------------------------------------------- |
3531 |
C |
3532 |
110 CONTINUE |
3533 |
C |
3534 |
DO 112 JK = 1 , KFLEV |
3535 |
DO 111 JL = 1, KDLON |
3536 |
IMX1=IMX(JL) |
3537 |
IMX2=JK |
3538 |
IF (PCLDLU(JL,JK).GT.ZEPSC) THEN |
3539 |
IMXP(JL)=IMX2 |
3540 |
ELSE |
3541 |
IMXP(JL)=IMX1 |
3542 |
END IF |
3543 |
IMAXC=MAX(IMXP(JL),IMAXC) |
3544 |
IMX(JL)=IMXP(JL) |
3545 |
111 CONTINUE |
3546 |
112 CONTINUE |
3547 |
CGM******* |
3548 |
IMAXC=KFLEV |
3549 |
CGM******* |
3550 |
C |
3551 |
DO 114 JK = 1 , KFLEV+1 |
3552 |
DO 113 JL = 1, KDLON |
3553 |
PFLUX(JL,1,JK) = PFLUC(JL,1,JK) |
3554 |
PFLUX(JL,2,JK) = PFLUC(JL,2,JK) |
3555 |
113 CONTINUE |
3556 |
114 CONTINUE |
3557 |
C |
3558 |
C ------------------------------------------------------------------ |
3559 |
C |
3560 |
C* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES |
3561 |
C --------------------------------------- |
3562 |
C |
3563 |
IF (IMAXC.GT.0) THEN |
3564 |
C |
3565 |
IMXP1 = IMAXC + 1 |
3566 |
IMXM1 = IMAXC - 1 |
3567 |
C |
3568 |
C* 2.0 INITIALIZE TO CLEAR-SKY FLUXES |
3569 |
C ------------------------------ |
3570 |
C |
3571 |
200 CONTINUE |
3572 |
C |
3573 |
DO 203 JK1=1,KFLEV+1 |
3574 |
DO 202 JK2=1,KFLEV+1 |
3575 |
DO 201 JL = 1, KDLON |
3576 |
ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1) |
3577 |
ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1) |
3578 |
201 CONTINUE |
3579 |
202 CONTINUE |
3580 |
203 CONTINUE |
3581 |
C |
3582 |
C* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD |
3583 |
C ---------------------------------------------- |
3584 |
C |
3585 |
210 CONTINUE |
3586 |
C |
3587 |
DO 213 JKC = 1 , IMAXC |
3588 |
JCLOUD=JKC |
3589 |
JKCP1=JCLOUD+1 |
3590 |
C |
3591 |
C* 2.1.1 ABOVE THE CLOUD |
3592 |
C --------------- |
3593 |
C |
3594 |
2110 CONTINUE |
3595 |
C |
3596 |
DO 2115 JK=JKCP1,KFLEV+1 |
3597 |
JKM1=JK-1 |
3598 |
DO 2111 JL = 1, KDLON |
3599 |
ZFU(JL)=0. |
3600 |
2111 CONTINUE |
3601 |
IF (JK .GT. JKCP1) THEN |
3602 |
DO 2113 JKJ=JKCP1,JKM1 |
3603 |
DO 2112 JL = 1, KDLON |
3604 |
ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ) |
3605 |
2112 CONTINUE |
3606 |
2113 CONTINUE |
3607 |
END IF |
3608 |
C |
3609 |
DO 2114 JL = 1, KDLON |
3610 |
ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL) |
3611 |
2114 CONTINUE |
3612 |
2115 CONTINUE |
3613 |
C |
3614 |
C* 2.1.2 BELOW THE CLOUD |
3615 |
C --------------- |
3616 |
C |
3617 |
2120 CONTINUE |
3618 |
C |
3619 |
DO 2125 JK=1,JCLOUD |
3620 |
JKP1=JK+1 |
3621 |
DO 2121 JL = 1, KDLON |
3622 |
ZFD(JL)=0. |
3623 |
2121 CONTINUE |
3624 |
C |
3625 |
IF (JK .LT. JCLOUD) THEN |
3626 |
DO 2123 JKJ=JKP1,JCLOUD |
3627 |
DO 2122 JL = 1, KDLON |
3628 |
ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ) |
3629 |
2122 CONTINUE |
3630 |
2123 CONTINUE |
3631 |
END IF |
3632 |
DO 2124 JL = 1, KDLON |
3633 |
ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL) |
3634 |
2124 CONTINUE |
3635 |
2125 CONTINUE |
3636 |
C |
3637 |
213 CONTINUE |
3638 |
C |
3639 |
C |
3640 |
C* 2.2 CLOUD COVER MATRIX |
3641 |
C ------------------ |
3642 |
C |
3643 |
C* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN |
3644 |
C HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1 |
3645 |
C |
3646 |
220 CONTINUE |
3647 |
C |
3648 |
DO 223 JK1 = 1 , KFLEV+1 |
3649 |
DO 222 JK2 = 1 , KFLEV+1 |
3650 |
DO 221 JL = 1, KDLON |
3651 |
ZCLM(JL,JK1,JK2) = 0. |
3652 |
221 CONTINUE |
3653 |
222 CONTINUE |
3654 |
223 CONTINUE |
3655 |
C |
3656 |
C |
3657 |
C |
3658 |
C* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION |
3659 |
C ------------------------------------------ |
3660 |
C |
3661 |
240 CONTINUE |
3662 |
C |
3663 |
DO 244 JK1 = 2 , KFLEV+1 |
3664 |
DO 241 JL = 1, KDLON |
3665 |
ZCLEAR(JL)=1. |
3666 |
ZCLOUD(JL)=0. |
3667 |
241 CONTINUE |
3668 |
DO 243 JK = JK1 - 1 , 1 , -1 |
3669 |
DO 242 JL = 1, KDLON |
3670 |
IF (NOVLP.EQ.1) THEN |
3671 |
c* maximum-random |
3672 |
ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) |
3673 |
* /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
3674 |
ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL) |
3675 |
ZCLOUD(JL) = PCLDLU(JL,JK) |
3676 |
ELSE IF (NOVLP.EQ.2) THEN |
3677 |
c* maximum |
3678 |
ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK)) |
3679 |
ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
3680 |
ELSE IF (NOVLP.EQ.3) THEN |
3681 |
c* random |
3682 |
ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK)) |
3683 |
ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
3684 |
ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
3685 |
END IF |
3686 |
242 CONTINUE |
3687 |
243 CONTINUE |
3688 |
244 CONTINUE |
3689 |
C |
3690 |
C |
3691 |
C* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION |
3692 |
C ------------------------------------------ |
3693 |
C |
3694 |
250 CONTINUE |
3695 |
C |
3696 |
DO 254 JK1 = 1 , KFLEV |
3697 |
DO 251 JL = 1, KDLON |
3698 |
ZCLEAR(JL)=1. |
3699 |
ZCLOUD(JL)=0. |
3700 |
251 CONTINUE |
3701 |
DO 253 JK = JK1 , KFLEV |
3702 |
DO 252 JL = 1, KDLON |
3703 |
IF (NOVLP.EQ.1) THEN |
3704 |
c* maximum-random |
3705 |
ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) |
3706 |
* /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
3707 |
ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL) |
3708 |
ZCLOUD(JL) = PCLDLD(JL,JK) |
3709 |
ELSE IF (NOVLP.EQ.2) THEN |
3710 |
c* maximum |
3711 |
ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK)) |
3712 |
ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
3713 |
ELSE IF (NOVLP.EQ.3) THEN |
3714 |
c* random |
3715 |
ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK)) |
3716 |
ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
3717 |
ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
3718 |
END IF |
3719 |
252 CONTINUE |
3720 |
253 CONTINUE |
3721 |
254 CONTINUE |
3722 |
C |
3723 |
C |
3724 |
C |
3725 |
C* 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS |
3726 |
C ---------------------------------------------- |
3727 |
C |
3728 |
300 CONTINUE |
3729 |
C |
3730 |
C* 3.1 DOWNWARD FLUXES |
3731 |
C --------------- |
3732 |
C |
3733 |
310 CONTINUE |
3734 |
C |
3735 |
DO 311 JL = 1, KDLON |
3736 |
PFLUX(JL,2,KFLEV+1) = 0. |
3737 |
311 CONTINUE |
3738 |
C |
3739 |
DO 317 JK1 = KFLEV , 1 , -1 |
3740 |
C |
3741 |
C* CONTRIBUTION FROM CLEAR-SKY FRACTION |
3742 |
C |
3743 |
DO 312 JL = 1, KDLON |
3744 |
ZFD (JL) = (1. - ZCLM(JL,JK1,KFLEV)) * ZDNF(JL,1,JK1) |
3745 |
312 CONTINUE |
3746 |
C |
3747 |
C* CONTRIBUTION FROM ADJACENT CLOUD |
3748 |
C |
3749 |
DO 313 JL = 1, KDLON |
3750 |
ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1) |
3751 |
313 CONTINUE |
3752 |
C |
3753 |
C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS |
3754 |
C |
3755 |
DO 315 JK = KFLEV-1 , JK1 , -1 |
3756 |
DO 314 JL = 1, KDLON |
3757 |
ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK) |
3758 |
ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1) |
3759 |
314 CONTINUE |
3760 |
315 CONTINUE |
3761 |
C |
3762 |
DO 316 JL = 1, KDLON |
3763 |
PFLUX(JL,2,JK1) = ZFD (JL) |
3764 |
316 CONTINUE |
3765 |
C |
3766 |
317 CONTINUE |
3767 |
C |
3768 |
C |
3769 |
C |
3770 |
C |
3771 |
C* 3.2 UPWARD FLUX AT THE SURFACE |
3772 |
C -------------------------- |
3773 |
C |
3774 |
320 CONTINUE |
3775 |
C |
3776 |
DO 321 JL = 1, KDLON |
3777 |
PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1) |
3778 |
321 CONTINUE |
3779 |
C |
3780 |
C |
3781 |
C |
3782 |
C* 3.3 UPWARD FLUXES |
3783 |
C ------------- |
3784 |
C |
3785 |
330 CONTINUE |
3786 |
C |
3787 |
DO 337 JK1 = 2 , KFLEV+1 |
3788 |
C |
3789 |
C* CONTRIBUTION FROM CLEAR-SKY FRACTION |
3790 |
C |
3791 |
DO 332 JL = 1, KDLON |
3792 |
ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1) |
3793 |
332 CONTINUE |
3794 |
C |
3795 |
C* CONTRIBUTION FROM ADJACENT CLOUD |
3796 |
C |
3797 |
DO 333 JL = 1, KDLON |
3798 |
ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1) |
3799 |
333 CONTINUE |
3800 |
C |
3801 |
C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS |
3802 |
C |
3803 |
DO 335 JK = 2 , JK1-1 |
3804 |
DO 334 JL = 1, KDLON |
3805 |
ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK) |
3806 |
ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1) |
3807 |
334 CONTINUE |
3808 |
335 CONTINUE |
3809 |
C |
3810 |
DO 336 JL = 1, KDLON |
3811 |
PFLUX(JL,1,JK1) = ZFU (JL) |
3812 |
336 CONTINUE |
3813 |
C |
3814 |
337 CONTINUE |
3815 |
C |
3816 |
C |
3817 |
END IF |
3818 |
C |
3819 |
C |
3820 |
C* 2.3 END OF CLOUD EFFECT COMPUTATIONS |
3821 |
C |
3822 |
230 CONTINUE |
3823 |
C |
3824 |
IF (.NOT.LEVOIGT) THEN |
3825 |
DO 231 JL = 1, KDLON |
3826 |
ZFN10(JL) = PFLUX(JL,1,KLIM) + PFLUX(JL,2,KLIM) |
3827 |
231 CONTINUE |
3828 |
DO 233 JK = KLIM+1 , KFLEV+1 |
3829 |
DO 232 JL = 1, KDLON |
3830 |
ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1) |
3831 |
PFLUX(JL,1,JK) = ZFN10(JL) |
3832 |
PFLUX(JL,2,JK) = 0.0 |
3833 |
232 CONTINUE |
3834 |
233 CONTINUE |
3835 |
ENDIF |
3836 |
C |
3837 |
RETURN |
3838 |
END |
3839 |
SUBROUTINE LWB(PDT0,PTAVE,PTL |
3840 |
S , PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL |
3841 |
S , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP) |
3842 |
use dimens_m |
3843 |
use dimphy |
3844 |
use raddim |
3845 |
IMPLICIT none |
3846 |
include "raddimlw.h" |
3847 |
C |
3848 |
C----------------------------------------------------------------------- |
3849 |
C PURPOSE. |
3850 |
C -------- |
3851 |
C COMPUTES PLANCK FUNCTIONS |
3852 |
C |
3853 |
C EXPLICIT ARGUMENTS : |
3854 |
C -------------------- |
3855 |
C ==== INPUTS === |
3856 |
C PDT0 : (KDLON) ; SURFACE TEMPERATURE DISCONTINUITY |
3857 |
C PTAVE : (KDLON,KFLEV) ; TEMPERATURE |
3858 |
C PTL : (KDLON,0:KFLEV) ; HALF LEVEL TEMPERATURE |
3859 |
C ==== OUTPUTS === |
3860 |
C PB : (KDLON,Ninter,KFLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION |
3861 |
C PBINT : (KDLON,KFLEV+1) ; HALF LEVEL PLANCK FUNCTION |
3862 |
C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION |
3863 |
C PBSUR : (KDLON,Ninter) ; SURFACE SPECTRAL PLANCK FUNCTION |
3864 |
C PBTOP : (KDLON,Ninter) ; TOP SPECTRAL PLANCK FUNCTION |
3865 |
C PDBSL : (KDLON,Ninter,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT |
3866 |
C PGA : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS |
3867 |
C PGB : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS |
3868 |
C PGASUR, PGBSUR (KDLON,8,2) ; SURFACE PADE APPROXIMANTS |
3869 |
C PGATOP, PGBTOP (KDLON,8,2) ; T.O.A. PADE APPROXIMANTS |
3870 |
C |
3871 |
C IMPLICIT ARGUMENTS : NONE |
3872 |
C -------------------- |
3873 |
C |
3874 |
C METHOD. |
3875 |
C ------- |
3876 |
C |
3877 |
C 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS |
3878 |
C FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION |
3879 |
C |
3880 |
C REFERENCE. |
3881 |
C ---------- |
3882 |
C |
3883 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
3884 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS " |
3885 |
C |
3886 |
C AUTHOR. |
3887 |
C ------- |
3888 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
3889 |
C |
3890 |
C MODIFICATIONS. |
3891 |
C -------------- |
3892 |
C ORIGINAL : 89-07-14 |
3893 |
C |
3894 |
C----------------------------------------------------------------------- |
3895 |
C |
3896 |
C ARGUMENTS: |
3897 |
C |
3898 |
REAL*8 PDT0(KDLON) |
3899 |
REAL*8 PTAVE(KDLON,KFLEV) |
3900 |
REAL*8 PTL(KDLON,KFLEV+1) |
3901 |
C |
3902 |
REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION |
3903 |
REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION |
3904 |
REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
3905 |
REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION |
3906 |
REAL*8 PBTOP(KDLON,Ninter) ! TOP SPECTRAL PLANCK FUNCTION |
3907 |
REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
3908 |
REAL*8 PGA(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS |
3909 |
REAL*8 PGB(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS |
3910 |
REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
3911 |
REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
3912 |
REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
3913 |
REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
3914 |
C |
3915 |
C------------------------------------------------------------------------- |
3916 |
C* LOCAL VARIABLES: |
3917 |
INTEGER INDB(KDLON),INDS(KDLON) |
3918 |
REAL*8 ZBLAY(KDLON,KFLEV),ZBLEV(KDLON,KFLEV+1) |
3919 |
REAL*8 ZRES(KDLON),ZRES2(KDLON),ZTI(KDLON),ZTI2(KDLON) |
3920 |
c |
3921 |
INTEGER jk, jl, ic, jnu, jf, jg |
3922 |
INTEGER jk1, jk2 |
3923 |
INTEGER k, j, ixtox, indto, ixtx, indt |
3924 |
INTEGER indsu, indtp |
3925 |
REAL*8 zdsto1, zdstox, zdst1, zdstx |
3926 |
c |
3927 |
C* Quelques parametres: |
3928 |
REAL*8 TSTAND |
3929 |
PARAMETER (TSTAND=250.0) |
3930 |
REAL*8 TSTP |
3931 |
PARAMETER (TSTP=12.5) |
3932 |
INTEGER MXIXT |
3933 |
PARAMETER (MXIXT=10) |
3934 |
C |
3935 |
C* Used Data Block: |
3936 |
REAL*8 TINTP(11) |
3937 |
SAVE TINTP |
3938 |
REAL*8 GA(11,16,3), GB(11,16,3) |
3939 |
SAVE GA, GB |
3940 |
REAL*8 XP(6,6) |
3941 |
SAVE XP |
3942 |
c |
3943 |
DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250., |
3944 |
S 262.5, 275., 287.5, 300., 312.5 / |
3945 |
C----------------------------------------------------------------------- |
3946 |
C-- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ---------------- |
3947 |
C |
3948 |
C |
3949 |
C |
3950 |
C |
3951 |
C-- R.D. -- G = - 0.2 SLA |
3952 |
C |
3953 |
C |
3954 |
C----- INTERVAL = 1 ----- T = 187.5 |
3955 |
C |
3956 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
3957 |
DATA (GA( 1, 1,IC),IC=1,3) / |
3958 |
S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/ |
3959 |
DATA (GB( 1, 1,IC),IC=1,3) / |
3960 |
S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/ |
3961 |
DATA (GA( 1, 2,IC),IC=1,3) / |
3962 |
S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/ |
3963 |
DATA (GB( 1, 2,IC),IC=1,3) / |
3964 |
S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/ |
3965 |
C |
3966 |
C----- INTERVAL = 1 ----- T = 200.0 |
3967 |
C |
3968 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
3969 |
DATA (GA( 2, 1,IC),IC=1,3) / |
3970 |
S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/ |
3971 |
DATA (GB( 2, 1,IC),IC=1,3) / |
3972 |
S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/ |
3973 |
DATA (GA( 2, 2,IC),IC=1,3) / |
3974 |
S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/ |
3975 |
DATA (GB( 2, 2,IC),IC=1,3) / |
3976 |
S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/ |
3977 |
C |
3978 |
C----- INTERVAL = 1 ----- T = 212.5 |
3979 |
C |
3980 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
3981 |
DATA (GA( 3, 1,IC),IC=1,3) / |
3982 |
S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/ |
3983 |
DATA (GB( 3, 1,IC),IC=1,3) / |
3984 |
S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/ |
3985 |
DATA (GA( 3, 2,IC),IC=1,3) / |
3986 |
S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/ |
3987 |
DATA (GB( 3, 2,IC),IC=1,3) / |
3988 |
S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/ |
3989 |
C |
3990 |
C----- INTERVAL = 1 ----- T = 225.0 |
3991 |
C |
3992 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
3993 |
DATA (GA( 4, 1,IC),IC=1,3) / |
3994 |
S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/ |
3995 |
DATA (GB( 4, 1,IC),IC=1,3) / |
3996 |
S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/ |
3997 |
DATA (GA( 4, 2,IC),IC=1,3) / |
3998 |
S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/ |
3999 |
DATA (GB( 4, 2,IC),IC=1,3) / |
4000 |
S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/ |
4001 |
C |
4002 |
C----- INTERVAL = 1 ----- T = 237.5 |
4003 |
C |
4004 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4005 |
DATA (GA( 5, 1,IC),IC=1,3) / |
4006 |
S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/ |
4007 |
DATA (GB( 5, 1,IC),IC=1,3) / |
4008 |
S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/ |
4009 |
DATA (GA( 5, 2,IC),IC=1,3) / |
4010 |
S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/ |
4011 |
DATA (GB( 5, 2,IC),IC=1,3) / |
4012 |
S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/ |
4013 |
C |
4014 |
C----- INTERVAL = 1 ----- T = 250.0 |
4015 |
C |
4016 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4017 |
DATA (GA( 6, 1,IC),IC=1,3) / |
4018 |
S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/ |
4019 |
DATA (GB( 6, 1,IC),IC=1,3) / |
4020 |
S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/ |
4021 |
DATA (GA( 6, 2,IC),IC=1,3) / |
4022 |
S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/ |
4023 |
DATA (GB( 6, 2,IC),IC=1,3) / |
4024 |
S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/ |
4025 |
C |
4026 |
C----- INTERVAL = 1 ----- T = 262.5 |
4027 |
C |
4028 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4029 |
DATA (GA( 7, 1,IC),IC=1,3) / |
4030 |
S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/ |
4031 |
DATA (GB( 7, 1,IC),IC=1,3) / |
4032 |
S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/ |
4033 |
DATA (GA( 7, 2,IC),IC=1,3) / |
4034 |
S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/ |
4035 |
DATA (GB( 7, 2,IC),IC=1,3) / |
4036 |
S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/ |
4037 |
C |
4038 |
C----- INTERVAL = 1 ----- T = 275.0 |
4039 |
C |
4040 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4041 |
DATA (GA( 8, 1,IC),IC=1,3) / |
4042 |
S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/ |
4043 |
DATA (GB( 8, 1,IC),IC=1,3) / |
4044 |
S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/ |
4045 |
DATA (GA( 8, 2,IC),IC=1,3) / |
4046 |
S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/ |
4047 |
DATA (GB( 8, 2,IC),IC=1,3) / |
4048 |
S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/ |
4049 |
C |
4050 |
C----- INTERVAL = 1 ----- T = 287.5 |
4051 |
C |
4052 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4053 |
DATA (GA( 9, 1,IC),IC=1,3) / |
4054 |
S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/ |
4055 |
DATA (GB( 9, 1,IC),IC=1,3) / |
4056 |
S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/ |
4057 |
DATA (GA( 9, 2,IC),IC=1,3) / |
4058 |
S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/ |
4059 |
DATA (GB( 9, 2,IC),IC=1,3) / |
4060 |
S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/ |
4061 |
C |
4062 |
C----- INTERVAL = 1 ----- T = 300.0 |
4063 |
C |
4064 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4065 |
DATA (GA(10, 1,IC),IC=1,3) / |
4066 |
S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/ |
4067 |
DATA (GB(10, 1,IC),IC=1,3) / |
4068 |
S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/ |
4069 |
DATA (GA(10, 2,IC),IC=1,3) / |
4070 |
S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/ |
4071 |
DATA (GB(10, 2,IC),IC=1,3) / |
4072 |
S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/ |
4073 |
C |
4074 |
C----- INTERVAL = 1 ----- T = 312.5 |
4075 |
C |
4076 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4077 |
DATA (GA(11, 1,IC),IC=1,3) / |
4078 |
S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/ |
4079 |
DATA (GB(11, 1,IC),IC=1,3) / |
4080 |
S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/ |
4081 |
DATA (GA(11, 2,IC),IC=1,3) / |
4082 |
S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/ |
4083 |
DATA (GB(11, 2,IC),IC=1,3) / |
4084 |
S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/ |
4085 |
C |
4086 |
C |
4087 |
C |
4088 |
C--- WATER VAPOR --- INTERVAL 2 -- 500-800 CM-1--- FROM ABS225 --------- |
4089 |
C |
4090 |
C |
4091 |
C |
4092 |
C |
4093 |
C--- R.D. --- G = 0.02 + 0.50 / ( 1 + 4.5 U ) |
4094 |
C |
4095 |
C |
4096 |
C----- INTERVAL = 2 ----- T = 187.5 |
4097 |
C |
4098 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4099 |
DATA (GA( 1, 3,IC),IC=1,3) / |
4100 |
S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/ |
4101 |
DATA (GB( 1, 3,IC),IC=1,3) / |
4102 |
S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/ |
4103 |
DATA (GA( 1, 4,IC),IC=1,3) / |
4104 |
S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/ |
4105 |
DATA (GB( 1, 4,IC),IC=1,3) / |
4106 |
S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/ |
4107 |
C |
4108 |
C----- INTERVAL = 2 ----- T = 200.0 |
4109 |
C |
4110 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4111 |
DATA (GA( 2, 3,IC),IC=1,3) / |
4112 |
S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/ |
4113 |
DATA (GB( 2, 3,IC),IC=1,3) / |
4114 |
S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/ |
4115 |
DATA (GA( 2, 4,IC),IC=1,3) / |
4116 |
S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/ |
4117 |
DATA (GB( 2, 4,IC),IC=1,3) / |
4118 |
S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/ |
4119 |
C |
4120 |
C----- INTERVAL = 2 ----- T = 212.5 |
4121 |
C |
4122 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4123 |
DATA (GA( 3, 3,IC),IC=1,3) / |
4124 |
S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/ |
4125 |
DATA (GB( 3, 3,IC),IC=1,3) / |
4126 |
S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/ |
4127 |
DATA (GA( 3, 4,IC),IC=1,3) / |
4128 |
S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/ |
4129 |
DATA (GB( 3, 4,IC),IC=1,3) / |
4130 |
S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/ |
4131 |
C |
4132 |
C----- INTERVAL = 2 ----- T = 225.0 |
4133 |
C |
4134 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4135 |
DATA (GA( 4, 3,IC),IC=1,3) / |
4136 |
S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/ |
4137 |
DATA (GB( 4, 3,IC),IC=1,3) / |
4138 |
S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/ |
4139 |
DATA (GA( 4, 4,IC),IC=1,3) / |
4140 |
S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/ |
4141 |
DATA (GB( 4, 4,IC),IC=1,3) / |
4142 |
S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/ |
4143 |
C |
4144 |
C----- INTERVAL = 2 ----- T = 237.5 |
4145 |
C |
4146 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4147 |
DATA (GA( 5, 3,IC),IC=1,3) / |
4148 |
S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/ |
4149 |
DATA (GB( 5, 3,IC),IC=1,3) / |
4150 |
S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/ |
4151 |
DATA (GA( 5, 4,IC),IC=1,3) / |
4152 |
S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/ |
4153 |
DATA (GB( 5, 4,IC),IC=1,3) / |
4154 |
S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/ |
4155 |
C |
4156 |
C----- INTERVAL = 2 ----- T = 250.0 |
4157 |
C |
4158 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4159 |
DATA (GA( 6, 3,IC),IC=1,3) / |
4160 |
S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/ |
4161 |
DATA (GB( 6, 3,IC),IC=1,3) / |
4162 |
S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/ |
4163 |
DATA (GA( 6, 4,IC),IC=1,3) / |
4164 |
S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/ |
4165 |
DATA (GB( 6, 4,IC),IC=1,3) / |
4166 |
S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/ |
4167 |
C |
4168 |
C----- INTERVAL = 2 ----- T = 262.5 |
4169 |
C |
4170 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4171 |
DATA (GA( 7, 3,IC),IC=1,3) / |
4172 |
S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/ |
4173 |
DATA (GB( 7, 3,IC),IC=1,3) / |
4174 |
S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/ |
4175 |
DATA (GA( 7, 4,IC),IC=1,3) / |
4176 |
S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/ |
4177 |
DATA (GB( 7, 4,IC),IC=1,3) / |
4178 |
S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/ |
4179 |
C |
4180 |
C----- INTERVAL = 2 ----- T = 275.0 |
4181 |
C |
4182 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4183 |
DATA (GA( 8, 3,IC),IC=1,3) / |
4184 |
S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/ |
4185 |
DATA (GB( 8, 3,IC),IC=1,3) / |
4186 |
S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/ |
4187 |
DATA (GA( 8, 4,IC),IC=1,3) / |
4188 |
S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/ |
4189 |
DATA (GB( 8, 4,IC),IC=1,3) / |
4190 |
S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/ |
4191 |
C |
4192 |
C----- INTERVAL = 2 ----- T = 287.5 |
4193 |
C |
4194 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4195 |
DATA (GA( 9, 3,IC),IC=1,3) / |
4196 |
S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/ |
4197 |
DATA (GB( 9, 3,IC),IC=1,3) / |
4198 |
S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/ |
4199 |
DATA (GA( 9, 4,IC),IC=1,3) / |
4200 |
S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/ |
4201 |
DATA (GB( 9, 4,IC),IC=1,3) / |
4202 |
S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/ |
4203 |
C |
4204 |
C----- INTERVAL = 2 ----- T = 300.0 |
4205 |
C |
4206 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4207 |
DATA (GA(10, 3,IC),IC=1,3) / |
4208 |
S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/ |
4209 |
DATA (GB(10, 3,IC),IC=1,3) / |
4210 |
S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/ |
4211 |
DATA (GA(10, 4,IC),IC=1,3) / |
4212 |
S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/ |
4213 |
DATA (GB(10, 4,IC),IC=1,3) / |
4214 |
S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/ |
4215 |
C |
4216 |
C----- INTERVAL = 2 ----- T = 312.5 |
4217 |
C |
4218 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4219 |
DATA (GA(11, 3,IC),IC=1,3) / |
4220 |
S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/ |
4221 |
DATA (GB(11, 3,IC),IC=1,3) / |
4222 |
S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/ |
4223 |
DATA (GA(11, 4,IC),IC=1,3) / |
4224 |
S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/ |
4225 |
DATA (GB(11, 4,IC),IC=1,3) / |
4226 |
S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/ |
4227 |
C |
4228 |
C |
4229 |
C |
4230 |
C |
4231 |
C |
4232 |
C |
4233 |
C- WATER VAPOR - INT. 3 -- 800-970 + 1110-1250 CM-1 -- FIT FROM 215 IS - |
4234 |
C |
4235 |
C |
4236 |
C-- WATER VAPOR LINES IN THE WINDOW REGION (800-1250 CM-1) |
4237 |
C |
4238 |
C |
4239 |
C |
4240 |
C--- G = 3.875E-03 --------------- |
4241 |
C |
4242 |
C----- INTERVAL = 3 ----- T = 187.5 |
4243 |
C |
4244 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4245 |
DATA (GA( 1, 7,IC),IC=1,3) / |
4246 |
S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/ |
4247 |
DATA (GB( 1, 7,IC),IC=1,3) / |
4248 |
S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/ |
4249 |
DATA (GA( 1, 8,IC),IC=1,3) / |
4250 |
S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/ |
4251 |
DATA (GB( 1, 8,IC),IC=1,3) / |
4252 |
S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/ |
4253 |
C |
4254 |
C----- INTERVAL = 3 ----- T = 200.0 |
4255 |
C |
4256 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4257 |
DATA (GA( 2, 7,IC),IC=1,3) / |
4258 |
S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/ |
4259 |
DATA (GB( 2, 7,IC),IC=1,3) / |
4260 |
S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/ |
4261 |
DATA (GA( 2, 8,IC),IC=1,3) / |
4262 |
S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/ |
4263 |
DATA (GB( 2, 8,IC),IC=1,3) / |
4264 |
S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/ |
4265 |
C |
4266 |
C----- INTERVAL = 3 ----- T = 212.5 |
4267 |
C |
4268 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4269 |
DATA (GA( 3, 7,IC),IC=1,3) / |
4270 |
S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/ |
4271 |
DATA (GB( 3, 7,IC),IC=1,3) / |
4272 |
S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/ |
4273 |
DATA (GA( 3, 8,IC),IC=1,3) / |
4274 |
S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/ |
4275 |
DATA (GB( 3, 8,IC),IC=1,3) / |
4276 |
S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/ |
4277 |
C |
4278 |
C----- INTERVAL = 3 ----- T = 225.0 |
4279 |
C |
4280 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4281 |
DATA (GA( 4, 7,IC),IC=1,3) / |
4282 |
S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/ |
4283 |
DATA (GB( 4, 7,IC),IC=1,3) / |
4284 |
S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/ |
4285 |
DATA (GA( 4, 8,IC),IC=1,3) / |
4286 |
S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/ |
4287 |
DATA (GB( 4, 8,IC),IC=1,3) / |
4288 |
S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/ |
4289 |
C |
4290 |
C----- INTERVAL = 3 ----- T = 237.5 |
4291 |
C |
4292 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4293 |
DATA (GA( 5, 7,IC),IC=1,3) / |
4294 |
S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/ |
4295 |
DATA (GB( 5, 7,IC),IC=1,3) / |
4296 |
S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/ |
4297 |
DATA (GA( 5, 8,IC),IC=1,3) / |
4298 |
S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/ |
4299 |
DATA (GB( 5, 8,IC),IC=1,3) / |
4300 |
S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/ |
4301 |
C |
4302 |
C----- INTERVAL = 3 ----- T = 250.0 |
4303 |
C |
4304 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4305 |
DATA (GA( 6, 7,IC),IC=1,3) / |
4306 |
S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/ |
4307 |
DATA (GB( 6, 7,IC),IC=1,3) / |
4308 |
S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/ |
4309 |
DATA (GA( 6, 8,IC),IC=1,3) / |
4310 |
S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/ |
4311 |
DATA (GB( 6, 8,IC),IC=1,3) / |
4312 |
S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/ |
4313 |
C |
4314 |
C----- INTERVAL = 3 ----- T = 262.5 |
4315 |
C |
4316 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4317 |
DATA (GA( 7, 7,IC),IC=1,3) / |
4318 |
S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/ |
4319 |
DATA (GB( 7, 7,IC),IC=1,3) / |
4320 |
S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/ |
4321 |
DATA (GA( 7, 8,IC),IC=1,3) / |
4322 |
S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/ |
4323 |
DATA (GB( 7, 8,IC),IC=1,3) / |
4324 |
S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/ |
4325 |
C |
4326 |
C----- INTERVAL = 3 ----- T = 275.0 |
4327 |
C |
4328 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4329 |
DATA (GA( 8, 7,IC),IC=1,3) / |
4330 |
S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/ |
4331 |
DATA (GB( 8, 7,IC),IC=1,3) / |
4332 |
S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/ |
4333 |
DATA (GA( 8, 8,IC),IC=1,3) / |
4334 |
S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/ |
4335 |
DATA (GB( 8, 8,IC),IC=1,3) / |
4336 |
S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/ |
4337 |
C |
4338 |
C----- INTERVAL = 3 ----- T = 287.5 |
4339 |
C |
4340 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4341 |
DATA (GA( 9, 7,IC),IC=1,3) / |
4342 |
S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/ |
4343 |
DATA (GB( 9, 7,IC),IC=1,3) / |
4344 |
S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/ |
4345 |
DATA (GA( 9, 8,IC),IC=1,3) / |
4346 |
S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/ |
4347 |
DATA (GB( 9, 8,IC),IC=1,3) / |
4348 |
S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/ |
4349 |
C |
4350 |
C----- INTERVAL = 3 ----- T = 300.0 |
4351 |
C |
4352 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4353 |
DATA (GA(10, 7,IC),IC=1,3) / |
4354 |
S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/ |
4355 |
DATA (GB(10, 7,IC),IC=1,3) / |
4356 |
S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/ |
4357 |
DATA (GA(10, 8,IC),IC=1,3) / |
4358 |
S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/ |
4359 |
DATA (GB(10, 8,IC),IC=1,3) / |
4360 |
S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/ |
4361 |
C |
4362 |
C----- INTERVAL = 3 ----- T = 312.5 |
4363 |
C |
4364 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4365 |
DATA (GA(11, 7,IC),IC=1,3) / |
4366 |
S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/ |
4367 |
DATA (GB(11, 7,IC),IC=1,3) / |
4368 |
S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/ |
4369 |
DATA (GA(11, 8,IC),IC=1,3) / |
4370 |
S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/ |
4371 |
DATA (GB(11, 8,IC),IC=1,3) / |
4372 |
S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/ |
4373 |
C |
4374 |
C |
4375 |
C-- WATER VAPOR -- 970-1110 CM-1 ---------------------------------------- |
4376 |
C |
4377 |
C-- G = 3.6E-03 |
4378 |
C |
4379 |
C----- INTERVAL = 4 ----- T = 187.5 |
4380 |
C |
4381 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4382 |
DATA (GA( 1, 9,IC),IC=1,3) / |
4383 |
S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/ |
4384 |
DATA (GB( 1, 9,IC),IC=1,3) / |
4385 |
S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/ |
4386 |
DATA (GA( 1,10,IC),IC=1,3) / |
4387 |
S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/ |
4388 |
DATA (GB( 1,10,IC),IC=1,3) / |
4389 |
S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/ |
4390 |
C |
4391 |
C----- INTERVAL = 4 ----- T = 200.0 |
4392 |
C |
4393 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4394 |
DATA (GA( 2, 9,IC),IC=1,3) / |
4395 |
S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/ |
4396 |
DATA (GB( 2, 9,IC),IC=1,3) / |
4397 |
S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/ |
4398 |
DATA (GA( 2,10,IC),IC=1,3) / |
4399 |
S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/ |
4400 |
DATA (GB( 2,10,IC),IC=1,3) / |
4401 |
S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/ |
4402 |
C |
4403 |
C----- INTERVAL = 4 ----- T = 212.5 |
4404 |
C |
4405 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4406 |
DATA (GA( 3, 9,IC),IC=1,3) / |
4407 |
S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/ |
4408 |
DATA (GB( 3, 9,IC),IC=1,3) / |
4409 |
S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/ |
4410 |
DATA (GA( 3,10,IC),IC=1,3) / |
4411 |
S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/ |
4412 |
DATA (GB( 3,10,IC),IC=1,3) / |
4413 |
S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/ |
4414 |
C |
4415 |
C----- INTERVAL = 4 ----- T = 225.0 |
4416 |
C |
4417 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4418 |
DATA (GA( 4, 9,IC),IC=1,3) / |
4419 |
S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/ |
4420 |
DATA (GB( 4, 9,IC),IC=1,3) / |
4421 |
S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/ |
4422 |
DATA (GA( 4,10,IC),IC=1,3) / |
4423 |
S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/ |
4424 |
DATA (GB( 4,10,IC),IC=1,3) / |
4425 |
S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/ |
4426 |
C |
4427 |
C----- INTERVAL = 4 ----- T = 237.5 |
4428 |
C |
4429 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4430 |
DATA (GA( 5, 9,IC),IC=1,3) / |
4431 |
S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/ |
4432 |
DATA (GB( 5, 9,IC),IC=1,3) / |
4433 |
S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/ |
4434 |
DATA (GA( 5,10,IC),IC=1,3) / |
4435 |
S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/ |
4436 |
DATA (GB( 5,10,IC),IC=1,3) / |
4437 |
S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/ |
4438 |
C |
4439 |
C----- INTERVAL = 4 ----- T = 250.0 |
4440 |
C |
4441 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4442 |
DATA (GA( 6, 9,IC),IC=1,3) / |
4443 |
S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/ |
4444 |
DATA (GB( 6, 9,IC),IC=1,3) / |
4445 |
S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/ |
4446 |
DATA (GA( 6,10,IC),IC=1,3) / |
4447 |
S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/ |
4448 |
DATA (GB( 6,10,IC),IC=1,3) / |
4449 |
S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/ |
4450 |
C |
4451 |
C----- INTERVAL = 4 ----- T = 262.5 |
4452 |
C |
4453 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4454 |
DATA (GA( 7, 9,IC),IC=1,3) / |
4455 |
S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/ |
4456 |
DATA (GB( 7, 9,IC),IC=1,3) / |
4457 |
S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/ |
4458 |
DATA (GA( 7,10,IC),IC=1,3) / |
4459 |
S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/ |
4460 |
DATA (GB( 7,10,IC),IC=1,3) / |
4461 |
S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/ |
4462 |
C |
4463 |
C----- INTERVAL = 4 ----- T = 275.0 |
4464 |
C |
4465 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4466 |
DATA (GA( 8, 9,IC),IC=1,3) / |
4467 |
S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/ |
4468 |
DATA (GB( 8, 9,IC),IC=1,3) / |
4469 |
S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/ |
4470 |
DATA (GA( 8,10,IC),IC=1,3) / |
4471 |
S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/ |
4472 |
DATA (GB( 8,10,IC),IC=1,3) / |
4473 |
S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/ |
4474 |
C |
4475 |
C----- INTERVAL = 4 ----- T = 287.5 |
4476 |
C |
4477 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4478 |
DATA (GA( 9, 9,IC),IC=1,3) / |
4479 |
S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/ |
4480 |
DATA (GB( 9, 9,IC),IC=1,3) / |
4481 |
S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/ |
4482 |
DATA (GA( 9,10,IC),IC=1,3) / |
4483 |
S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/ |
4484 |
DATA (GB( 9,10,IC),IC=1,3) / |
4485 |
S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/ |
4486 |
C |
4487 |
C----- INTERVAL = 4 ----- T = 300.0 |
4488 |
C |
4489 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4490 |
DATA (GA(10, 9,IC),IC=1,3) / |
4491 |
S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/ |
4492 |
DATA (GB(10, 9,IC),IC=1,3) / |
4493 |
S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/ |
4494 |
DATA (GA(10,10,IC),IC=1,3) / |
4495 |
S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/ |
4496 |
DATA (GB(10,10,IC),IC=1,3) / |
4497 |
S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/ |
4498 |
C |
4499 |
C----- INTERVAL = 4 ----- T = 312.5 |
4500 |
C |
4501 |
C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
4502 |
DATA (GA(11, 9,IC),IC=1,3) / |
4503 |
S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/ |
4504 |
DATA (GB(11, 9,IC),IC=1,3) / |
4505 |
S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/ |
4506 |
DATA (GA(11,10,IC),IC=1,3) / |
4507 |
S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/ |
4508 |
DATA (GB(11,10,IC),IC=1,3) / |
4509 |
S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/ |
4510 |
C |
4511 |
C |
4512 |
C |
4513 |
C-- H2O -- WEAKER PARTS OF THE STRONG BANDS -- FROM ABS225 ---- |
4514 |
C |
4515 |
C-- WATER VAPOR --- 350 - 500 CM-1 |
4516 |
C |
4517 |
C-- G = - 0.2*SLA, 0.0 +0.5/(1+0.5U) |
4518 |
C |
4519 |
C----- INTERVAL = 5 ----- T = 187.5 |
4520 |
C |
4521 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4522 |
DATA (GA( 1, 5,IC),IC=1,3) / |
4523 |
S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/ |
4524 |
DATA (GB( 1, 5,IC),IC=1,3) / |
4525 |
S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/ |
4526 |
DATA (GA( 1, 6,IC),IC=1,3) / |
4527 |
S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/ |
4528 |
DATA (GB( 1, 6,IC),IC=1,3) / |
4529 |
S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/ |
4530 |
C |
4531 |
C----- INTERVAL = 5 ----- T = 200.0 |
4532 |
C |
4533 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4534 |
DATA (GA( 2, 5,IC),IC=1,3) / |
4535 |
S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/ |
4536 |
DATA (GB( 2, 5,IC),IC=1,3) / |
4537 |
S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/ |
4538 |
DATA (GA( 2, 6,IC),IC=1,3) / |
4539 |
S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/ |
4540 |
DATA (GB( 2, 6,IC),IC=1,3) / |
4541 |
S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/ |
4542 |
C |
4543 |
C----- INTERVAL = 5 ----- T = 212.5 |
4544 |
C |
4545 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4546 |
DATA (GA( 3, 5,IC),IC=1,3) / |
4547 |
S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/ |
4548 |
DATA (GB( 3, 5,IC),IC=1,3) / |
4549 |
S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/ |
4550 |
DATA (GA( 3, 6,IC),IC=1,3) / |
4551 |
S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/ |
4552 |
DATA (GB( 3, 6,IC),IC=1,3) / |
4553 |
S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/ |
4554 |
C |
4555 |
C----- INTERVAL = 5 ----- T = 225.0 |
4556 |
C |
4557 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4558 |
DATA (GA( 4, 5,IC),IC=1,3) / |
4559 |
S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/ |
4560 |
DATA (GB( 4, 5,IC),IC=1,3) / |
4561 |
S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/ |
4562 |
DATA (GA( 4, 6,IC),IC=1,3) / |
4563 |
S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/ |
4564 |
DATA (GB( 4, 6,IC),IC=1,3) / |
4565 |
S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/ |
4566 |
C |
4567 |
C----- INTERVAL = 5 ----- T = 237.5 |
4568 |
C |
4569 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4570 |
DATA (GA( 5, 5,IC),IC=1,3) / |
4571 |
S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/ |
4572 |
DATA (GB( 5, 5,IC),IC=1,3) / |
4573 |
S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/ |
4574 |
DATA (GA( 5, 6,IC),IC=1,3) / |
4575 |
S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/ |
4576 |
DATA (GB( 5, 6,IC),IC=1,3) / |
4577 |
S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/ |
4578 |
C |
4579 |
C----- INTERVAL = 5 ----- T = 250.0 |
4580 |
C |
4581 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4582 |
DATA (GA( 6, 5,IC),IC=1,3) / |
4583 |
S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/ |
4584 |
DATA (GB( 6, 5,IC),IC=1,3) / |
4585 |
S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/ |
4586 |
DATA (GA( 6, 6,IC),IC=1,3) / |
4587 |
S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/ |
4588 |
DATA (GB( 6, 6,IC),IC=1,3) / |
4589 |
S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/ |
4590 |
C |
4591 |
C----- INTERVAL = 5 ----- T = 262.5 |
4592 |
C |
4593 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4594 |
DATA (GA( 7, 5,IC),IC=1,3) / |
4595 |
S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/ |
4596 |
DATA (GB( 7, 5,IC),IC=1,3) / |
4597 |
S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/ |
4598 |
DATA (GA( 7, 6,IC),IC=1,3) / |
4599 |
S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/ |
4600 |
DATA (GB( 7, 6,IC),IC=1,3) / |
4601 |
S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/ |
4602 |
C |
4603 |
C----- INTERVAL = 5 ----- T = 275.0 |
4604 |
C |
4605 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4606 |
DATA (GA( 8, 5,IC),IC=1,3) / |
4607 |
S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/ |
4608 |
DATA (GB( 8, 5,IC),IC=1,3) / |
4609 |
S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/ |
4610 |
DATA (GA( 8, 6,IC),IC=1,3) / |
4611 |
S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/ |
4612 |
DATA (GB( 8, 6,IC),IC=1,3) / |
4613 |
S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/ |
4614 |
C |
4615 |
C----- INTERVAL = 5 ----- T = 287.5 |
4616 |
C |
4617 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4618 |
DATA (GA( 9, 5,IC),IC=1,3) / |
4619 |
S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/ |
4620 |
DATA (GB( 9, 5,IC),IC=1,3) / |
4621 |
S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/ |
4622 |
DATA (GA( 9, 6,IC),IC=1,3) / |
4623 |
S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/ |
4624 |
DATA (GB( 9, 6,IC),IC=1,3) / |
4625 |
S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/ |
4626 |
C |
4627 |
C----- INTERVAL = 5 ----- T = 300.0 |
4628 |
C |
4629 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4630 |
DATA (GA(10, 5,IC),IC=1,3) / |
4631 |
S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/ |
4632 |
DATA (GB(10, 5,IC),IC=1,3) / |
4633 |
S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/ |
4634 |
DATA (GA(10, 6,IC),IC=1,3) / |
4635 |
S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/ |
4636 |
DATA (GB(10, 6,IC),IC=1,3) / |
4637 |
S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/ |
4638 |
C |
4639 |
C----- INTERVAL = 5 ----- T = 312.5 |
4640 |
C |
4641 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4642 |
DATA (GA(11, 5,IC),IC=1,3) / |
4643 |
S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/ |
4644 |
DATA (GB(11, 5,IC),IC=1,3) / |
4645 |
S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/ |
4646 |
DATA (GA(11, 6,IC),IC=1,3) / |
4647 |
S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/ |
4648 |
DATA (GB(11, 6,IC),IC=1,3) / |
4649 |
S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/ |
4650 |
C |
4651 |
C |
4652 |
C |
4653 |
C |
4654 |
C- WATER VAPOR - WINGS OF VIBRATION-ROTATION BAND - 1250-1450+1880-2820 - |
4655 |
C--- G = 0.0 |
4656 |
C |
4657 |
C |
4658 |
C----- INTERVAL = 6 ----- T = 187.5 |
4659 |
C |
4660 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4661 |
DATA (GA( 1,11,IC),IC=1,3) / |
4662 |
S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/ |
4663 |
DATA (GB( 1,11,IC),IC=1,3) / |
4664 |
S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/ |
4665 |
DATA (GA( 1,12,IC),IC=1,3) / |
4666 |
S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/ |
4667 |
DATA (GB( 1,12,IC),IC=1,3) / |
4668 |
S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/ |
4669 |
C |
4670 |
C----- INTERVAL = 6 ----- T = 200.0 |
4671 |
C |
4672 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4673 |
DATA (GA( 2,11,IC),IC=1,3) / |
4674 |
S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/ |
4675 |
DATA (GB( 2,11,IC),IC=1,3) / |
4676 |
S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/ |
4677 |
DATA (GA( 2,12,IC),IC=1,3) / |
4678 |
S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/ |
4679 |
DATA (GB( 2,12,IC),IC=1,3) / |
4680 |
S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/ |
4681 |
C |
4682 |
C----- INTERVAL = 6 ----- T = 212.5 |
4683 |
C |
4684 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4685 |
DATA (GA( 3,11,IC),IC=1,3) / |
4686 |
S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/ |
4687 |
DATA (GB( 3,11,IC),IC=1,3) / |
4688 |
S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/ |
4689 |
DATA (GA( 3,12,IC),IC=1,3) / |
4690 |
S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/ |
4691 |
DATA (GB( 3,12,IC),IC=1,3) / |
4692 |
S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/ |
4693 |
C |
4694 |
C----- INTERVAL = 6 ----- T = 225.0 |
4695 |
C |
4696 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4697 |
DATA (GA( 4,11,IC),IC=1,3) / |
4698 |
S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/ |
4699 |
DATA (GB( 4,11,IC),IC=1,3) / |
4700 |
S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/ |
4701 |
DATA (GA( 4,12,IC),IC=1,3) / |
4702 |
S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/ |
4703 |
DATA (GB( 4,12,IC),IC=1,3) / |
4704 |
S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/ |
4705 |
C |
4706 |
C----- INTERVAL = 6 ----- T = 237.5 |
4707 |
C |
4708 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4709 |
DATA (GA( 5,11,IC),IC=1,3) / |
4710 |
S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/ |
4711 |
DATA (GB( 5,11,IC),IC=1,3) / |
4712 |
S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/ |
4713 |
DATA (GA( 5,12,IC),IC=1,3) / |
4714 |
S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/ |
4715 |
DATA (GB( 5,12,IC),IC=1,3) / |
4716 |
S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/ |
4717 |
C |
4718 |
C----- INTERVAL = 6 ----- T = 250.0 |
4719 |
C |
4720 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4721 |
DATA (GA( 6,11,IC),IC=1,3) / |
4722 |
S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/ |
4723 |
DATA (GB( 6,11,IC),IC=1,3) / |
4724 |
S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/ |
4725 |
DATA (GA( 6,12,IC),IC=1,3) / |
4726 |
S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/ |
4727 |
DATA (GB( 6,12,IC),IC=1,3) / |
4728 |
S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/ |
4729 |
C |
4730 |
C----- INTERVAL = 6 ----- T = 262.5 |
4731 |
C |
4732 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4733 |
DATA (GA( 7,11,IC),IC=1,3) / |
4734 |
S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/ |
4735 |
DATA (GB( 7,11,IC),IC=1,3) / |
4736 |
S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/ |
4737 |
DATA (GA( 7,12,IC),IC=1,3) / |
4738 |
S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/ |
4739 |
DATA (GB( 7,12,IC),IC=1,3) / |
4740 |
S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/ |
4741 |
C |
4742 |
C----- INTERVAL = 6 ----- T = 275.0 |
4743 |
C |
4744 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4745 |
DATA (GA( 8,11,IC),IC=1,3) / |
4746 |
S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/ |
4747 |
DATA (GB( 8,11,IC),IC=1,3) / |
4748 |
S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/ |
4749 |
DATA (GA( 8,12,IC),IC=1,3) / |
4750 |
S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/ |
4751 |
DATA (GB( 8,12,IC),IC=1,3) / |
4752 |
S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/ |
4753 |
C |
4754 |
C----- INTERVAL = 6 ----- T = 287.5 |
4755 |
C |
4756 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4757 |
DATA (GA( 9,11,IC),IC=1,3) / |
4758 |
S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/ |
4759 |
DATA (GB( 9,11,IC),IC=1,3) / |
4760 |
S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/ |
4761 |
DATA (GA( 9,12,IC),IC=1,3) / |
4762 |
S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/ |
4763 |
DATA (GB( 9,12,IC),IC=1,3) / |
4764 |
S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/ |
4765 |
C |
4766 |
C----- INTERVAL = 6 ----- T = 300.0 |
4767 |
C |
4768 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4769 |
DATA (GA(10,11,IC),IC=1,3) / |
4770 |
S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/ |
4771 |
DATA (GB(10,11,IC),IC=1,3) / |
4772 |
S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/ |
4773 |
DATA (GA(10,12,IC),IC=1,3) / |
4774 |
S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/ |
4775 |
DATA (GB(10,12,IC),IC=1,3) / |
4776 |
S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/ |
4777 |
C |
4778 |
C----- INTERVAL = 6 ----- T = 312.5 |
4779 |
C |
4780 |
C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
4781 |
DATA (GA(11,11,IC),IC=1,3) / |
4782 |
S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/ |
4783 |
DATA (GB(11,11,IC),IC=1,3) / |
4784 |
S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/ |
4785 |
DATA (GA(11,12,IC),IC=1,3) / |
4786 |
S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/ |
4787 |
DATA (GB(11,12,IC),IC=1,3) / |
4788 |
S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/ |
4789 |
C |
4790 |
C |
4791 |
C |
4792 |
C |
4793 |
C |
4794 |
C-- END WATER VAPOR |
4795 |
C |
4796 |
C |
4797 |
C-- CO2 -- INT.2 -- 500-800 CM-1 --- FROM ABS225 ---------------------- |
4798 |
C |
4799 |
C |
4800 |
C |
4801 |
C-- FIU = 0.8 + MAX(0.35,(7-IU)*0.9) , X/T, 9 |
4802 |
C |
4803 |
C----- INTERVAL = 2 ----- T = 187.5 |
4804 |
C |
4805 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4806 |
DATA (GA( 1,13,IC),IC=1,3) / |
4807 |
S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/ |
4808 |
DATA (GB( 1,13,IC),IC=1,3) / |
4809 |
S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/ |
4810 |
DATA (GA( 1,14,IC),IC=1,3) / |
4811 |
S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/ |
4812 |
DATA (GB( 1,14,IC),IC=1,3) / |
4813 |
S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/ |
4814 |
C |
4815 |
C----- INTERVAL = 2 ----- T = 200.0 |
4816 |
C |
4817 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4818 |
DATA (GA( 2,13,IC),IC=1,3) / |
4819 |
S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/ |
4820 |
DATA (GB( 2,13,IC),IC=1,3) / |
4821 |
S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/ |
4822 |
DATA (GA( 2,14,IC),IC=1,3) / |
4823 |
S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/ |
4824 |
DATA (GB( 2,14,IC),IC=1,3) / |
4825 |
S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/ |
4826 |
C |
4827 |
C----- INTERVAL = 2 ----- T = 212.5 |
4828 |
C |
4829 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4830 |
DATA (GA( 3,13,IC),IC=1,3) / |
4831 |
S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/ |
4832 |
DATA (GB( 3,13,IC),IC=1,3) / |
4833 |
S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/ |
4834 |
DATA (GA( 3,14,IC),IC=1,3) / |
4835 |
S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/ |
4836 |
DATA (GB( 3,14,IC),IC=1,3) / |
4837 |
S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/ |
4838 |
C |
4839 |
C----- INTERVAL = 2 ----- T = 225.0 |
4840 |
C |
4841 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4842 |
DATA (GA( 4,13,IC),IC=1,3) / |
4843 |
S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/ |
4844 |
DATA (GB( 4,13,IC),IC=1,3) / |
4845 |
S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/ |
4846 |
DATA (GA( 4,14,IC),IC=1,3) / |
4847 |
S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/ |
4848 |
DATA (GB( 4,14,IC),IC=1,3) / |
4849 |
S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/ |
4850 |
C |
4851 |
C----- INTERVAL = 2 ----- T = 237.5 |
4852 |
C |
4853 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4854 |
DATA (GA( 5,13,IC),IC=1,3) / |
4855 |
S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/ |
4856 |
DATA (GB( 5,13,IC),IC=1,3) / |
4857 |
S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/ |
4858 |
DATA (GA( 5,14,IC),IC=1,3) / |
4859 |
S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/ |
4860 |
DATA (GB( 5,14,IC),IC=1,3) / |
4861 |
S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/ |
4862 |
C |
4863 |
C----- INTERVAL = 2 ----- T = 250.0 |
4864 |
C |
4865 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4866 |
DATA (GA( 6,13,IC),IC=1,3) / |
4867 |
S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/ |
4868 |
DATA (GB( 6,13,IC),IC=1,3) / |
4869 |
S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/ |
4870 |
DATA (GA( 6,14,IC),IC=1,3) / |
4871 |
S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/ |
4872 |
DATA (GB( 6,14,IC),IC=1,3) / |
4873 |
S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/ |
4874 |
C |
4875 |
C----- INTERVAL = 2 ----- T = 262.5 |
4876 |
C |
4877 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4878 |
DATA (GA( 7,13,IC),IC=1,3) / |
4879 |
S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/ |
4880 |
DATA (GB( 7,13,IC),IC=1,3) / |
4881 |
S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/ |
4882 |
DATA (GA( 7,14,IC),IC=1,3) / |
4883 |
S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/ |
4884 |
DATA (GB( 7,14,IC),IC=1,3) / |
4885 |
S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/ |
4886 |
C |
4887 |
C----- INTERVAL = 2 ----- T = 275.0 |
4888 |
C |
4889 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4890 |
DATA (GA( 8,13,IC),IC=1,3) / |
4891 |
S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/ |
4892 |
DATA (GB( 8,13,IC),IC=1,3) / |
4893 |
S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/ |
4894 |
DATA (GA( 8,14,IC),IC=1,3) / |
4895 |
S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/ |
4896 |
DATA (GB( 8,14,IC),IC=1,3) / |
4897 |
S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/ |
4898 |
C |
4899 |
C----- INTERVAL = 2 ----- T = 287.5 |
4900 |
C |
4901 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4902 |
DATA (GA( 9,13,IC),IC=1,3) / |
4903 |
S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/ |
4904 |
DATA (GB( 9,13,IC),IC=1,3) / |
4905 |
S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/ |
4906 |
DATA (GA( 9,14,IC),IC=1,3) / |
4907 |
S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/ |
4908 |
DATA (GB( 9,14,IC),IC=1,3) / |
4909 |
S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/ |
4910 |
C |
4911 |
C----- INTERVAL = 2 ----- T = 300.0 |
4912 |
C |
4913 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4914 |
DATA (GA(10,13,IC),IC=1,3) / |
4915 |
S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/ |
4916 |
DATA (GB(10,13,IC),IC=1,3) / |
4917 |
S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/ |
4918 |
DATA (GA(10,14,IC),IC=1,3) / |
4919 |
S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/ |
4920 |
DATA (GB(10,14,IC),IC=1,3) / |
4921 |
S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/ |
4922 |
C |
4923 |
C----- INTERVAL = 2 ----- T = 312.5 |
4924 |
C |
4925 |
C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
4926 |
DATA (GA(11,13,IC),IC=1,3) / |
4927 |
S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/ |
4928 |
DATA (GB(11,13,IC),IC=1,3) / |
4929 |
S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/ |
4930 |
DATA (GA(11,14,IC),IC=1,3) / |
4931 |
S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/ |
4932 |
DATA (GB(11,14,IC),IC=1,3) / |
4933 |
S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/ |
4934 |
C |
4935 |
C |
4936 |
C |
4937 |
C |
4938 |
C |
4939 |
C |
4940 |
C |
4941 |
C |
4942 |
C |
4943 |
C |
4944 |
C-- CARBON DIOXIDE LINES IN THE WINDOW REGION (800-1250 CM-1) |
4945 |
C |
4946 |
C |
4947 |
C-- G = 0.0 |
4948 |
C |
4949 |
C |
4950 |
C----- INTERVAL = 4 ----- T = 187.5 |
4951 |
C |
4952 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4953 |
DATA (GA( 1,15,IC),IC=1,3) / |
4954 |
S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/ |
4955 |
DATA (GB( 1,15,IC),IC=1,3) / |
4956 |
S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/ |
4957 |
DATA (GA( 1,16,IC),IC=1,3) / |
4958 |
S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/ |
4959 |
DATA (GB( 1,16,IC),IC=1,3) / |
4960 |
S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/ |
4961 |
C |
4962 |
C----- INTERVAL = 4 ----- T = 200.0 |
4963 |
C |
4964 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4965 |
DATA (GA( 2,15,IC),IC=1,3) / |
4966 |
S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/ |
4967 |
DATA (GB( 2,15,IC),IC=1,3) / |
4968 |
S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/ |
4969 |
DATA (GA( 2,16,IC),IC=1,3) / |
4970 |
S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/ |
4971 |
DATA (GB( 2,16,IC),IC=1,3) / |
4972 |
S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/ |
4973 |
C |
4974 |
C----- INTERVAL = 4 ----- T = 212.5 |
4975 |
C |
4976 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4977 |
DATA (GA( 3,15,IC),IC=1,3) / |
4978 |
S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/ |
4979 |
DATA (GB( 3,15,IC),IC=1,3) / |
4980 |
S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/ |
4981 |
DATA (GA( 3,16,IC),IC=1,3) / |
4982 |
S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/ |
4983 |
DATA (GB( 3,16,IC),IC=1,3) / |
4984 |
S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/ |
4985 |
C |
4986 |
C----- INTERVAL = 4 ----- T = 225.0 |
4987 |
C |
4988 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
4989 |
DATA (GA( 4,15,IC),IC=1,3) / |
4990 |
S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/ |
4991 |
DATA (GB( 4,15,IC),IC=1,3) / |
4992 |
S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/ |
4993 |
DATA (GA( 4,16,IC),IC=1,3) / |
4994 |
S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/ |
4995 |
DATA (GB( 4,16,IC),IC=1,3) / |
4996 |
S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/ |
4997 |
C |
4998 |
C----- INTERVAL = 4 ----- T = 237.5 |
4999 |
C |
5000 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5001 |
DATA (GA( 5,15,IC),IC=1,3) / |
5002 |
S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/ |
5003 |
DATA (GB( 5,15,IC),IC=1,3) / |
5004 |
S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/ |
5005 |
DATA (GA( 5,16,IC),IC=1,3) / |
5006 |
S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/ |
5007 |
DATA (GB( 5,16,IC),IC=1,3) / |
5008 |
S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/ |
5009 |
C |
5010 |
C----- INTERVAL = 4 ----- T = 250.0 |
5011 |
C |
5012 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5013 |
DATA (GA( 6,15,IC),IC=1,3) / |
5014 |
S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/ |
5015 |
DATA (GB( 6,15,IC),IC=1,3) / |
5016 |
S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/ |
5017 |
DATA (GA( 6,16,IC),IC=1,3) / |
5018 |
S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/ |
5019 |
DATA (GB( 6,16,IC),IC=1,3) / |
5020 |
S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/ |
5021 |
C |
5022 |
C----- INTERVAL = 4 ----- T = 262.5 |
5023 |
C |
5024 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5025 |
DATA (GA( 7,15,IC),IC=1,3) / |
5026 |
S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/ |
5027 |
DATA (GB( 7,15,IC),IC=1,3) / |
5028 |
S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/ |
5029 |
DATA (GA( 7,16,IC),IC=1,3) / |
5030 |
S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/ |
5031 |
DATA (GB( 7,16,IC),IC=1,3) / |
5032 |
S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/ |
5033 |
C |
5034 |
C----- INTERVAL = 4 ----- T = 275.0 |
5035 |
C |
5036 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5037 |
DATA (GA( 8,15,IC),IC=1,3) / |
5038 |
S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/ |
5039 |
DATA (GB( 8,15,IC),IC=1,3) / |
5040 |
S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/ |
5041 |
DATA (GA( 8,16,IC),IC=1,3) / |
5042 |
S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/ |
5043 |
DATA (GB( 8,16,IC),IC=1,3) / |
5044 |
S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/ |
5045 |
C |
5046 |
C----- INTERVAL = 4 ----- T = 287.5 |
5047 |
C |
5048 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5049 |
DATA (GA( 9,15,IC),IC=1,3) / |
5050 |
S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/ |
5051 |
DATA (GB( 9,15,IC),IC=1,3) / |
5052 |
S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/ |
5053 |
DATA (GA( 9,16,IC),IC=1,3) / |
5054 |
S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/ |
5055 |
DATA (GB( 9,16,IC),IC=1,3) / |
5056 |
S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/ |
5057 |
C |
5058 |
C----- INTERVAL = 4 ----- T = 300.0 |
5059 |
C |
5060 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5061 |
DATA (GA(10,15,IC),IC=1,3) / |
5062 |
S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/ |
5063 |
DATA (GB(10,15,IC),IC=1,3) / |
5064 |
S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/ |
5065 |
DATA (GA(10,16,IC),IC=1,3) / |
5066 |
S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/ |
5067 |
DATA (GB(10,16,IC),IC=1,3) / |
5068 |
S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/ |
5069 |
C |
5070 |
C----- INTERVAL = 4 ----- T = 312.5 |
5071 |
C |
5072 |
C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
5073 |
DATA (GA(11,15,IC),IC=1,3) / |
5074 |
S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/ |
5075 |
DATA (GB(11,15,IC),IC=1,3) / |
5076 |
S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/ |
5077 |
DATA (GA(11,16,IC),IC=1,3) / |
5078 |
S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/ |
5079 |
DATA (GB(11,16,IC),IC=1,3) / |
5080 |
S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/ |
5081 |
|
5082 |
C ------------------------------------------------------------------ |
5083 |
DATA (( XP( J,K),J=1,6), K=1,6) / |
5084 |
S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03, |
5085 |
S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03, |
5086 |
S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03, |
5087 |
S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02, |
5088 |
S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03, |
5089 |
S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02, |
5090 |
S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03, |
5091 |
S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02, |
5092 |
S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02, |
5093 |
S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01, |
5094 |
S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03, |
5095 |
S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 / |
5096 |
C |
5097 |
C |
5098 |
C* 1.0 PLANCK FUNCTIONS AND GRADIENTS |
5099 |
C ------------------------------ |
5100 |
C |
5101 |
100 CONTINUE |
5102 |
C |
5103 |
DO 102 JK = 1 , KFLEV+1 |
5104 |
DO 101 JL = 1, KDLON |
5105 |
PBINT(JL,JK) = 0. |
5106 |
101 CONTINUE |
5107 |
102 CONTINUE |
5108 |
DO 103 JL = 1, KDLON |
5109 |
PBSUIN(JL) = 0. |
5110 |
103 CONTINUE |
5111 |
C |
5112 |
DO 141 JNU=1,Ninter |
5113 |
C |
5114 |
C |
5115 |
C* 1.1 LEVELS FROM SURFACE TO KFLEV |
5116 |
C ---------------------------- |
5117 |
C |
5118 |
110 CONTINUE |
5119 |
C |
5120 |
DO 112 JK = 1 , KFLEV |
5121 |
DO 111 JL = 1, KDLON |
5122 |
ZTI(JL)=(PTL(JL,JK)-TSTAND)/TSTAND |
5123 |
ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU) |
5124 |
S +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU) |
5125 |
S ))))) |
5126 |
PBINT(JL,JK)=PBINT(JL,JK)+ZRES(JL) |
5127 |
PB(JL,JNU,JK)= ZRES(JL) |
5128 |
ZBLEV(JL,JK) = ZRES(JL) |
5129 |
ZTI2(JL)=(PTAVE(JL,JK)-TSTAND)/TSTAND |
5130 |
ZRES2(JL)=XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU) |
5131 |
S +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU) |
5132 |
S ))))) |
5133 |
ZBLAY(JL,JK) = ZRES2(JL) |
5134 |
111 CONTINUE |
5135 |
112 CONTINUE |
5136 |
C |
5137 |
C |
5138 |
C* 1.2 TOP OF THE ATMOSPHERE AND SURFACE |
5139 |
C --------------------------------- |
5140 |
C |
5141 |
120 CONTINUE |
5142 |
C |
5143 |
DO 121 JL = 1, KDLON |
5144 |
ZTI(JL)=(PTL(JL,KFLEV+1)-TSTAND)/TSTAND |
5145 |
ZTI2(JL) = (PTL(JL,1) + PDT0(JL) - TSTAND) / TSTAND |
5146 |
ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU) |
5147 |
S +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU) |
5148 |
S ))))) |
5149 |
ZRES2(JL) = XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU) |
5150 |
S +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU) |
5151 |
S ))))) |
5152 |
PBINT(JL,KFLEV+1) = PBINT(JL,KFLEV+1)+ZRES(JL) |
5153 |
PB(JL,JNU,KFLEV+1)= ZRES(JL) |
5154 |
ZBLEV(JL,KFLEV+1) = ZRES(JL) |
5155 |
PBTOP(JL,JNU) = ZRES(JL) |
5156 |
PBSUR(JL,JNU) = ZRES2(JL) |
5157 |
PBSUIN(JL) = PBSUIN(JL) + ZRES2(JL) |
5158 |
121 CONTINUE |
5159 |
C |
5160 |
C |
5161 |
C* 1.3 GRADIENTS IN SUB-LAYERS |
5162 |
C ----------------------- |
5163 |
C |
5164 |
130 CONTINUE |
5165 |
C |
5166 |
DO 132 JK = 1 , KFLEV |
5167 |
JK2 = 2 * JK |
5168 |
JK1 = JK2 - 1 |
5169 |
DO 131 JL = 1, KDLON |
5170 |
PDBSL(JL,JNU,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK) |
5171 |
PDBSL(JL,JNU,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK) |
5172 |
131 CONTINUE |
5173 |
132 CONTINUE |
5174 |
C |
5175 |
141 CONTINUE |
5176 |
C |
5177 |
C* 2.0 CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS |
5178 |
C --------------------------------------------- |
5179 |
C |
5180 |
200 CONTINUE |
5181 |
C |
5182 |
C |
5183 |
210 CONTINUE |
5184 |
C |
5185 |
DO 211 JL=1, KDLON |
5186 |
ZDSTO1 = (PTL(JL,KFLEV+1)-TINTP(1)) / TSTP |
5187 |
IXTOX = MAX( 1, MIN( MXIXT, INT( ZDSTO1 + 1. ) ) ) |
5188 |
ZDSTOX = (PTL(JL,KFLEV+1)-TINTP(IXTOX))/TSTP |
5189 |
IF (ZDSTOX.LT.0.5) THEN |
5190 |
INDTO=IXTOX |
5191 |
ELSE |
5192 |
INDTO=IXTOX+1 |
5193 |
END IF |
5194 |
INDB(JL)=INDTO |
5195 |
ZDST1 = (PTL(JL,1)-TINTP(1)) / TSTP |
5196 |
IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) ) |
5197 |
ZDSTX = (PTL(JL,1)-TINTP(IXTX))/TSTP |
5198 |
IF (ZDSTX.LT.0.5) THEN |
5199 |
INDT=IXTX |
5200 |
ELSE |
5201 |
INDT=IXTX+1 |
5202 |
END IF |
5203 |
INDS(JL)=INDT |
5204 |
211 CONTINUE |
5205 |
C |
5206 |
DO 214 JF=1,2 |
5207 |
DO 213 JG=1, 8 |
5208 |
DO 212 JL=1, KDLON |
5209 |
INDSU=INDS(JL) |
5210 |
PGASUR(JL,JG,JF)=GA(INDSU,2*JG-1,JF) |
5211 |
PGBSUR(JL,JG,JF)=GB(INDSU,2*JG-1,JF) |
5212 |
INDTP=INDB(JL) |
5213 |
PGATOP(JL,JG,JF)=GA(INDTP,2*JG-1,JF) |
5214 |
PGBTOP(JL,JG,JF)=GB(INDTP,2*JG-1,JF) |
5215 |
212 CONTINUE |
5216 |
213 CONTINUE |
5217 |
214 CONTINUE |
5218 |
C |
5219 |
220 CONTINUE |
5220 |
C |
5221 |
DO 225 JK=1,KFLEV |
5222 |
DO 221 JL=1, KDLON |
5223 |
ZDST1 = (PTAVE(JL,JK)-TINTP(1)) / TSTP |
5224 |
IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) ) |
5225 |
ZDSTX = (PTAVE(JL,JK)-TINTP(IXTX))/TSTP |
5226 |
IF (ZDSTX.LT.0.5) THEN |
5227 |
INDT=IXTX |
5228 |
ELSE |
5229 |
INDT=IXTX+1 |
5230 |
END IF |
5231 |
INDB(JL)=INDT |
5232 |
221 CONTINUE |
5233 |
C |
5234 |
DO 224 JF=1,2 |
5235 |
DO 223 JG=1, 8 |
5236 |
DO 222 JL=1, KDLON |
5237 |
INDT=INDB(JL) |
5238 |
PGA(JL,JG,JF,JK)=GA(INDT,2*JG,JF) |
5239 |
PGB(JL,JG,JF,JK)=GB(INDT,2*JG,JF) |
5240 |
222 CONTINUE |
5241 |
223 CONTINUE |
5242 |
224 CONTINUE |
5243 |
225 CONTINUE |
5244 |
C |
5245 |
C ------------------------------------------------------------------ |
5246 |
C |
5247 |
RETURN |
5248 |
END |
5249 |
SUBROUTINE LWV(KUAER,KTRAER, KLIM |
5250 |
R , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE |
5251 |
R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
5252 |
S , PCNTRB,PCTS,PFLUC) |
5253 |
use dimens_m |
5254 |
use dimphy |
5255 |
use YOMCST |
5256 |
use raddim |
5257 |
IMPLICIT none |
5258 |
include "raddimlw.h" |
5259 |
C |
5260 |
C----------------------------------------------------------------------- |
5261 |
C PURPOSE. |
5262 |
C -------- |
5263 |
C CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE |
5264 |
C FLUXES OR RADIANCES |
5265 |
C |
5266 |
C METHOD. |
5267 |
C ------- |
5268 |
C |
5269 |
C 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN |
5270 |
C CONTRIBUTIONS BY - THE NEARBY LAYERS |
5271 |
C - THE DISTANT LAYERS |
5272 |
C - THE BOUNDARY TERMS |
5273 |
C 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. |
5274 |
C |
5275 |
C REFERENCE. |
5276 |
C ---------- |
5277 |
C |
5278 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
5279 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
5280 |
C |
5281 |
C AUTHOR. |
5282 |
C ------- |
5283 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
5284 |
C |
5285 |
C MODIFICATIONS. |
5286 |
C -------------- |
5287 |
C ORIGINAL : 89-07-14 |
5288 |
C----------------------------------------------------------------------- |
5289 |
C |
5290 |
C* ARGUMENTS: |
5291 |
INTEGER KUAER,KTRAER, KLIM |
5292 |
C |
5293 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS |
5294 |
REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS |
5295 |
REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS |
5296 |
REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION |
5297 |
REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
5298 |
REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION |
5299 |
REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
5300 |
REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
5301 |
REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB) |
5302 |
REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE |
5303 |
REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5304 |
REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5305 |
REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS |
5306 |
REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS |
5307 |
REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS |
5308 |
REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS |
5309 |
C |
5310 |
REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX |
5311 |
REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM |
5312 |
REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
5313 |
C----------------------------------------------------------------------- |
5314 |
C LOCAL VARIABLES: |
5315 |
REAL*8 ZADJD(KDLON,KFLEV+1) |
5316 |
REAL*8 ZADJU(KDLON,KFLEV+1) |
5317 |
REAL*8 ZDBDT(KDLON,Ninter,KFLEV) |
5318 |
REAL*8 ZDISD(KDLON,KFLEV+1) |
5319 |
REAL*8 ZDISU(KDLON,KFLEV+1) |
5320 |
C |
5321 |
INTEGER jk, jl |
5322 |
C----------------------------------------------------------------------- |
5323 |
C |
5324 |
DO 112 JK=1,KFLEV+1 |
5325 |
DO 111 JL=1, KDLON |
5326 |
ZADJD(JL,JK)=0. |
5327 |
ZADJU(JL,JK)=0. |
5328 |
ZDISD(JL,JK)=0. |
5329 |
ZDISU(JL,JK)=0. |
5330 |
111 CONTINUE |
5331 |
112 CONTINUE |
5332 |
C |
5333 |
DO 114 JK=1,KFLEV |
5334 |
DO 113 JL=1, KDLON |
5335 |
PCTS(JL,JK)=0. |
5336 |
113 CONTINUE |
5337 |
114 CONTINUE |
5338 |
C |
5339 |
C* CONTRIBUTION FROM ADJACENT LAYERS |
5340 |
C |
5341 |
CALL LWVN(KUAER,KTRAER |
5342 |
R , PABCU,PDBSL,PGA,PGB |
5343 |
S , ZADJD,ZADJU,PCNTRB,ZDBDT) |
5344 |
C* CONTRIBUTION FROM DISTANT LAYERS |
5345 |
C |
5346 |
CALL LWVD(KUAER,KTRAER |
5347 |
R , PABCU,ZDBDT,PGA,PGB |
5348 |
S , PCNTRB,ZDISD,ZDISU) |
5349 |
C |
5350 |
C* EXCHANGE WITH THE BOUNDARIES |
5351 |
C |
5352 |
CALL LWVB(KUAER,KTRAER, KLIM |
5353 |
R , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP |
5354 |
R , ZDISD,ZDISU,PEMIS,PPMB |
5355 |
R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
5356 |
S , PCTS,PFLUC) |
5357 |
C |
5358 |
C |
5359 |
RETURN |
5360 |
END |
5361 |
SUBROUTINE LWVB(KUAER,KTRAER, KLIM |
5362 |
R , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP |
5363 |
R , PDISD,PDISU,PEMIS,PPMB |
5364 |
R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
5365 |
S , PCTS,PFLUC) |
5366 |
use dimens_m |
5367 |
use dimphy |
5368 |
use raddim |
5369 |
use radopt |
5370 |
IMPLICIT none |
5371 |
include "raddimlw.h" |
5372 |
C |
5373 |
C----------------------------------------------------------------------- |
5374 |
C PURPOSE. |
5375 |
C -------- |
5376 |
C INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL |
5377 |
C INTEGRATION |
5378 |
C |
5379 |
C METHOD. |
5380 |
C ------- |
5381 |
C |
5382 |
C 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE |
5383 |
C ATMOSPHERE |
5384 |
C 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND |
5385 |
C TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA |
5386 |
C 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES |
5387 |
C |
5388 |
C REFERENCE. |
5389 |
C ---------- |
5390 |
C |
5391 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
5392 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
5393 |
C |
5394 |
C AUTHOR. |
5395 |
C ------- |
5396 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
5397 |
C |
5398 |
C MODIFICATIONS. |
5399 |
C -------------- |
5400 |
C ORIGINAL : 89-07-14 |
5401 |
C Voigt lines (loop 2413 to 2427) - JJM & PhD - 01/96 |
5402 |
C----------------------------------------------------------------------- |
5403 |
C |
5404 |
C* 0.1 ARGUMENTS |
5405 |
C --------- |
5406 |
C |
5407 |
INTEGER KUAER,KTRAER, KLIM |
5408 |
C |
5409 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS |
5410 |
REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS |
5411 |
REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS |
5412 |
REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS |
5413 |
REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS |
5414 |
REAL*8 PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION |
5415 |
REAL*8 PBSUI(KDLON) ! SURFACE PLANCK FUNCTION |
5416 |
REAL*8 PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION |
5417 |
REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
5418 |
REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
5419 |
REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
5420 |
REAL*8 PPMB(KDLON,KFLEV+1) ! PRESSURE MB |
5421 |
REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5422 |
REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5423 |
REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
5424 |
REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
5425 |
REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
5426 |
REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
5427 |
C |
5428 |
REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
5429 |
REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM |
5430 |
C |
5431 |
C* LOCAL VARIABLES: |
5432 |
C |
5433 |
REAL*8 ZBGND(KDLON) |
5434 |
REAL*8 ZFD(KDLON) |
5435 |
REAL*8 ZFN10(KDLON) |
5436 |
REAL*8 ZFU(KDLON) |
5437 |
REAL*8 ZTT(KDLON,NTRA) |
5438 |
REAL*8 ZTT1(KDLON,NTRA) |
5439 |
REAL*8 ZTT2(KDLON,NTRA) |
5440 |
REAL*8 ZUU(KDLON,NUA) |
5441 |
REAL*8 ZCNSOL(KDLON) |
5442 |
REAL*8 ZCNTOP(KDLON) |
5443 |
C |
5444 |
INTEGER jk, jl, ja |
5445 |
INTEGER jstra, jstru |
5446 |
INTEGER ind1, ind2, ind3, ind4, in, jlim |
5447 |
REAL*8 zctstr |
5448 |
C----------------------------------------------------------------------- |
5449 |
C |
5450 |
C* 1. INITIALIZATION |
5451 |
C -------------- |
5452 |
C |
5453 |
100 CONTINUE |
5454 |
C |
5455 |
C |
5456 |
C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
5457 |
C --------------------------------- |
5458 |
C |
5459 |
120 CONTINUE |
5460 |
C |
5461 |
DO 122 JA=1,NTRA |
5462 |
DO 121 JL=1, KDLON |
5463 |
ZTT (JL,JA)=1.0 |
5464 |
ZTT1(JL,JA)=1.0 |
5465 |
ZTT2(JL,JA)=1.0 |
5466 |
121 CONTINUE |
5467 |
122 CONTINUE |
5468 |
C |
5469 |
DO 124 JA=1,NUA |
5470 |
DO 123 JL=1, KDLON |
5471 |
ZUU(JL,JA)=1.0 |
5472 |
123 CONTINUE |
5473 |
124 CONTINUE |
5474 |
C |
5475 |
C ------------------------------------------------------------------ |
5476 |
C |
5477 |
C* 2. VERTICAL INTEGRATION |
5478 |
C -------------------- |
5479 |
C |
5480 |
200 CONTINUE |
5481 |
C |
5482 |
IND1=0 |
5483 |
IND3=0 |
5484 |
IND4=1 |
5485 |
IND2=1 |
5486 |
C |
5487 |
C |
5488 |
C* 2.3 EXCHANGE WITH TOP OF THE ATMOSPHERE |
5489 |
C ----------------------------------- |
5490 |
C |
5491 |
230 CONTINUE |
5492 |
C |
5493 |
DO 235 JK = 1 , KFLEV |
5494 |
IN=(JK-1)*NG1P1+1 |
5495 |
C |
5496 |
DO 232 JA=1,KUAER |
5497 |
DO 231 JL=1, KDLON |
5498 |
ZUU(JL,JA)=PABCU(JL,JA,IN) |
5499 |
231 CONTINUE |
5500 |
232 CONTINUE |
5501 |
C |
5502 |
C |
5503 |
CALL LWTT(PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT) |
5504 |
C |
5505 |
DO 234 JL = 1, KDLON |
5506 |
ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1) *ZTT(JL,10) |
5507 |
2 +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
5508 |
3 +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
5509 |
4 +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
5510 |
5 +PBTOP(JL,5)*ZTT(JL,3) *ZTT(JL,14) |
5511 |
6 +PBTOP(JL,6)*ZTT(JL,6) *ZTT(JL,15) |
5512 |
ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK) |
5513 |
PFLUC(JL,2,JK)=ZFD(JL) |
5514 |
234 CONTINUE |
5515 |
C |
5516 |
235 CONTINUE |
5517 |
C |
5518 |
JK = KFLEV+1 |
5519 |
IN=(JK-1)*NG1P1+1 |
5520 |
C |
5521 |
DO 236 JL = 1, KDLON |
5522 |
ZCNTOP(JL)= PBTOP(JL,1) |
5523 |
1 + PBTOP(JL,2) |
5524 |
2 + PBTOP(JL,3) |
5525 |
3 + PBTOP(JL,4) |
5526 |
4 + PBTOP(JL,5) |
5527 |
5 + PBTOP(JL,6) |
5528 |
ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK) |
5529 |
PFLUC(JL,2,JK)=ZFD(JL) |
5530 |
236 CONTINUE |
5531 |
C |
5532 |
C* 2.4 COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA |
5533 |
C --------------------------------------- |
5534 |
C |
5535 |
240 CONTINUE |
5536 |
C |
5537 |
C |
5538 |
C* 2.4.1 INITIALIZATION |
5539 |
C -------------- |
5540 |
C |
5541 |
2410 CONTINUE |
5542 |
C |
5543 |
JLIM = KFLEV |
5544 |
C |
5545 |
IF (.NOT.LEVOIGT) THEN |
5546 |
DO 2412 JK = KFLEV,1,-1 |
5547 |
IF(PPMB(1,JK).LT.10.0) THEN |
5548 |
JLIM=JK |
5549 |
ENDIF |
5550 |
2412 CONTINUE |
5551 |
ENDIF |
5552 |
KLIM=JLIM |
5553 |
C |
5554 |
IF (.NOT.LEVOIGT) THEN |
5555 |
DO 2414 JA=1,KTRAER |
5556 |
DO 2413 JL=1, KDLON |
5557 |
ZTT1(JL,JA)=1.0 |
5558 |
2413 CONTINUE |
5559 |
2414 CONTINUE |
5560 |
C |
5561 |
C* 2.4.2 LOOP OVER LAYERS ABOVE 10 HPA |
5562 |
C ----------------------------- |
5563 |
C |
5564 |
2420 CONTINUE |
5565 |
C |
5566 |
DO 2427 JSTRA = KFLEV,JLIM,-1 |
5567 |
JSTRU=(JSTRA-1)*NG1P1+1 |
5568 |
C |
5569 |
DO 2423 JA=1,KUAER |
5570 |
DO 2422 JL=1, KDLON |
5571 |
ZUU(JL,JA)=PABCU(JL,JA,JSTRU) |
5572 |
2422 CONTINUE |
5573 |
2423 CONTINUE |
5574 |
C |
5575 |
C |
5576 |
CALL LWTT(PGA(1,1,1,JSTRA), PGB(1,1,1,JSTRA), ZUU, ZTT) |
5577 |
C |
5578 |
DO 2424 JL = 1, KDLON |
5579 |
ZCTSTR = |
5580 |
1 (PB(JL,1,JSTRA)+PB(JL,1,JSTRA+1)) |
5581 |
1 *(ZTT1(JL,1) *ZTT1(JL,10) |
5582 |
1 - ZTT (JL,1) *ZTT (JL,10)) |
5583 |
2 +(PB(JL,2,JSTRA)+PB(JL,2,JSTRA+1)) |
5584 |
2 *(ZTT1(JL,2)*ZTT1(JL,7)*ZTT1(JL,11) |
5585 |
2 - ZTT (JL,2)*ZTT (JL,7)*ZTT (JL,11)) |
5586 |
3 +(PB(JL,3,JSTRA)+PB(JL,3,JSTRA+1)) |
5587 |
3 *(ZTT1(JL,4)*ZTT1(JL,8)*ZTT1(JL,12) |
5588 |
3 - ZTT (JL,4)*ZTT (JL,8)*ZTT (JL,12)) |
5589 |
4 +(PB(JL,4,JSTRA)+PB(JL,4,JSTRA+1)) |
5590 |
4 *(ZTT1(JL,5)*ZTT1(JL,9)*ZTT1(JL,13) |
5591 |
4 - ZTT (JL,5)*ZTT (JL,9)*ZTT (JL,13)) |
5592 |
5 +(PB(JL,5,JSTRA)+PB(JL,5,JSTRA+1)) |
5593 |
5 *(ZTT1(JL,3) *ZTT1(JL,14) |
5594 |
5 - ZTT (JL,3) *ZTT (JL,14)) |
5595 |
6 +(PB(JL,6,JSTRA)+PB(JL,6,JSTRA+1)) |
5596 |
6 *(ZTT1(JL,6) *ZTT1(JL,15) |
5597 |
6 - ZTT (JL,6) *ZTT (JL,15)) |
5598 |
PCTS(JL,JSTRA)=ZCTSTR*0.5 |
5599 |
2424 CONTINUE |
5600 |
DO 2426 JA=1,KTRAER |
5601 |
DO 2425 JL=1, KDLON |
5602 |
ZTT1(JL,JA)=ZTT(JL,JA) |
5603 |
2425 CONTINUE |
5604 |
2426 CONTINUE |
5605 |
2427 CONTINUE |
5606 |
ENDIF |
5607 |
C Mise a zero de securite pour PCTS en cas de LEVOIGT |
5608 |
IF(LEVOIGT)THEN |
5609 |
DO 2429 JSTRA = 1,KFLEV |
5610 |
DO 2428 JL = 1, KDLON |
5611 |
PCTS(JL,JSTRA)=0. |
5612 |
2428 CONTINUE |
5613 |
2429 CONTINUE |
5614 |
ENDIF |
5615 |
C |
5616 |
C |
5617 |
C* 2.5 EXCHANGE WITH LOWER LIMIT |
5618 |
C ------------------------- |
5619 |
C |
5620 |
250 CONTINUE |
5621 |
C |
5622 |
DO 251 JL = 1, KDLON |
5623 |
ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL)) |
5624 |
S *PFLUC(JL,2,1)-PBINT(JL,1) |
5625 |
251 CONTINUE |
5626 |
C |
5627 |
JK = 1 |
5628 |
IN=(JK-1)*NG1P1+1 |
5629 |
C |
5630 |
DO 252 JL = 1, KDLON |
5631 |
ZCNSOL(JL)=PBSUR(JL,1) |
5632 |
1 +PBSUR(JL,2) |
5633 |
2 +PBSUR(JL,3) |
5634 |
3 +PBSUR(JL,4) |
5635 |
4 +PBSUR(JL,5) |
5636 |
5 +PBSUR(JL,6) |
5637 |
ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL) |
5638 |
ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK) |
5639 |
PFLUC(JL,1,JK)=ZFU(JL) |
5640 |
252 CONTINUE |
5641 |
C |
5642 |
DO 257 JK = 2 , KFLEV+1 |
5643 |
IN=(JK-1)*NG1P1+1 |
5644 |
C |
5645 |
C |
5646 |
DO 255 JA=1,KUAER |
5647 |
DO 254 JL=1, KDLON |
5648 |
ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN) |
5649 |
254 CONTINUE |
5650 |
255 CONTINUE |
5651 |
C |
5652 |
C |
5653 |
CALL LWTT(PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT) |
5654 |
C |
5655 |
DO 256 JL = 1, KDLON |
5656 |
ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1) *ZTT(JL,10) |
5657 |
2 +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
5658 |
3 +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
5659 |
4 +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
5660 |
5 +PBSUR(JL,5)*ZTT(JL,3) *ZTT(JL,14) |
5661 |
6 +PBSUR(JL,6)*ZTT(JL,6) *ZTT(JL,15) |
5662 |
ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL) |
5663 |
ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK) |
5664 |
PFLUC(JL,1,JK)=ZFU(JL) |
5665 |
256 CONTINUE |
5666 |
C |
5667 |
C |
5668 |
257 CONTINUE |
5669 |
C |
5670 |
C |
5671 |
C |
5672 |
C* 2.7 CLEAR-SKY FLUXES |
5673 |
C ---------------- |
5674 |
C |
5675 |
270 CONTINUE |
5676 |
C |
5677 |
IF (.NOT.LEVOIGT) THEN |
5678 |
DO 271 JL = 1, KDLON |
5679 |
ZFN10(JL) = PFLUC(JL,1,JLIM) + PFLUC(JL,2,JLIM) |
5680 |
271 CONTINUE |
5681 |
DO 273 JK = JLIM+1,KFLEV+1 |
5682 |
DO 272 JL = 1, KDLON |
5683 |
ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1) |
5684 |
PFLUC(JL,1,JK) = ZFN10(JL) |
5685 |
PFLUC(JL,2,JK) = 0. |
5686 |
272 CONTINUE |
5687 |
273 CONTINUE |
5688 |
ENDIF |
5689 |
C |
5690 |
C ------------------------------------------------------------------ |
5691 |
C |
5692 |
RETURN |
5693 |
END |
5694 |
SUBROUTINE LWVD(KUAER,KTRAER |
5695 |
S , PABCU,PDBDT |
5696 |
R , PGA,PGB |
5697 |
S , PCNTRB,PDISD,PDISU) |
5698 |
use dimens_m |
5699 |
use dimphy |
5700 |
use raddim |
5701 |
IMPLICIT none |
5702 |
include "raddimlw.h" |
5703 |
C |
5704 |
C----------------------------------------------------------------------- |
5705 |
C PURPOSE. |
5706 |
C -------- |
5707 |
C CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS |
5708 |
C |
5709 |
C METHOD. |
5710 |
C ------- |
5711 |
C |
5712 |
C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE |
5713 |
C CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE |
5714 |
C |
5715 |
C REFERENCE. |
5716 |
C ---------- |
5717 |
C |
5718 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
5719 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
5720 |
C |
5721 |
C AUTHOR. |
5722 |
C ------- |
5723 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
5724 |
C |
5725 |
C MODIFICATIONS. |
5726 |
C -------------- |
5727 |
C ORIGINAL : 89-07-14 |
5728 |
C----------------------------------------------------------------------- |
5729 |
C* ARGUMENTS: |
5730 |
C |
5731 |
INTEGER KUAER,KTRAER |
5732 |
C |
5733 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS |
5734 |
REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT |
5735 |
REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5736 |
REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5737 |
C |
5738 |
REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! ENERGY EXCHANGE MATRIX |
5739 |
REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
5740 |
REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
5741 |
C |
5742 |
C* LOCAL VARIABLES: |
5743 |
C |
5744 |
REAL*8 ZGLAYD(KDLON) |
5745 |
REAL*8 ZGLAYU(KDLON) |
5746 |
REAL*8 ZTT(KDLON,NTRA) |
5747 |
REAL*8 ZTT1(KDLON,NTRA) |
5748 |
REAL*8 ZTT2(KDLON,NTRA) |
5749 |
C |
5750 |
INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2 |
5751 |
INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2 |
5752 |
INTEGER ind1, ind2, ind3, ind4, itt |
5753 |
REAL*8 zww, zdzxdg, zdzxmg |
5754 |
C |
5755 |
C* 1. INITIALIZATION |
5756 |
C -------------- |
5757 |
C |
5758 |
100 CONTINUE |
5759 |
C |
5760 |
C* 1.1 INITIALIZE LAYER CONTRIBUTIONS |
5761 |
C ------------------------------ |
5762 |
C |
5763 |
110 CONTINUE |
5764 |
C |
5765 |
DO 112 JK = 1, KFLEV+1 |
5766 |
DO 111 JL = 1, KDLON |
5767 |
PDISD(JL,JK) = 0. |
5768 |
PDISU(JL,JK) = 0. |
5769 |
111 CONTINUE |
5770 |
112 CONTINUE |
5771 |
C |
5772 |
C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
5773 |
C --------------------------------- |
5774 |
C |
5775 |
120 CONTINUE |
5776 |
C |
5777 |
C |
5778 |
DO 122 JA = 1, NTRA |
5779 |
DO 121 JL = 1, KDLON |
5780 |
ZTT (JL,JA) = 1.0 |
5781 |
ZTT1(JL,JA) = 1.0 |
5782 |
ZTT2(JL,JA) = 1.0 |
5783 |
121 CONTINUE |
5784 |
122 CONTINUE |
5785 |
C |
5786 |
C ------------------------------------------------------------------ |
5787 |
C |
5788 |
C* 2. VERTICAL INTEGRATION |
5789 |
C -------------------- |
5790 |
C |
5791 |
200 CONTINUE |
5792 |
C |
5793 |
IND1=0 |
5794 |
IND3=0 |
5795 |
IND4=1 |
5796 |
IND2=1 |
5797 |
C |
5798 |
C |
5799 |
C* 2.2 CONTRIBUTION FROM DISTANT LAYERS |
5800 |
C --------------------------------- |
5801 |
C |
5802 |
220 CONTINUE |
5803 |
C |
5804 |
C |
5805 |
C* 2.2.1 DISTANT AND ABOVE LAYERS |
5806 |
C ------------------------ |
5807 |
C |
5808 |
2210 CONTINUE |
5809 |
C |
5810 |
C |
5811 |
C |
5812 |
C* 2.2.2 FIRST UPPER LEVEL |
5813 |
C ----------------- |
5814 |
C |
5815 |
2220 CONTINUE |
5816 |
C |
5817 |
DO 225 JK = 1 , KFLEV-1 |
5818 |
IKP1=JK+1 |
5819 |
IKN=(JK-1)*NG1P1+1 |
5820 |
IKD1= JK *NG1P1+1 |
5821 |
C |
5822 |
CALL LWTTM(PGA(1,1,1,JK), PGB(1,1,1,JK) |
5823 |
2 , PABCU(1,1,IKN),PABCU(1,1,IKD1),ZTT1) |
5824 |
C |
5825 |
C |
5826 |
C |
5827 |
C* 2.2.3 HIGHER UP |
5828 |
C --------- |
5829 |
C |
5830 |
2230 CONTINUE |
5831 |
C |
5832 |
ITT=1 |
5833 |
DO 224 JKJ=IKP1,KFLEV |
5834 |
IF(ITT.EQ.1) THEN |
5835 |
ITT=2 |
5836 |
ELSE |
5837 |
ITT=1 |
5838 |
ENDIF |
5839 |
IKJP1=JKJ+1 |
5840 |
IKD2= JKJ *NG1P1+1 |
5841 |
C |
5842 |
IF(ITT.EQ.1) THEN |
5843 |
CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ) |
5844 |
2 , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT1) |
5845 |
ELSE |
5846 |
CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ) |
5847 |
2 , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT2) |
5848 |
ENDIF |
5849 |
C |
5850 |
DO 2235 JA = 1, KTRAER |
5851 |
DO 2234 JL = 1, KDLON |
5852 |
ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5 |
5853 |
2234 CONTINUE |
5854 |
2235 CONTINUE |
5855 |
C |
5856 |
DO 2236 JL = 1, KDLON |
5857 |
ZWW=PDBDT(JL,1,JKJ)*ZTT(JL,1) *ZTT(JL,10) |
5858 |
S +PDBDT(JL,2,JKJ)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
5859 |
S +PDBDT(JL,3,JKJ)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
5860 |
S +PDBDT(JL,4,JKJ)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
5861 |
S +PDBDT(JL,5,JKJ)*ZTT(JL,3) *ZTT(JL,14) |
5862 |
S +PDBDT(JL,6,JKJ)*ZTT(JL,6) *ZTT(JL,15) |
5863 |
ZGLAYD(JL)=ZWW |
5864 |
ZDZXDG=ZGLAYD(JL) |
5865 |
PDISD(JL,JK)=PDISD(JL,JK)+ZDZXDG |
5866 |
PCNTRB(JL,JK,IKJP1)=ZDZXDG |
5867 |
2236 CONTINUE |
5868 |
C |
5869 |
C |
5870 |
224 CONTINUE |
5871 |
225 CONTINUE |
5872 |
C |
5873 |
C |
5874 |
C* 2.2.4 DISTANT AND BELOW LAYERS |
5875 |
C ------------------------ |
5876 |
C |
5877 |
2240 CONTINUE |
5878 |
C |
5879 |
C |
5880 |
C |
5881 |
C* 2.2.5 FIRST LOWER LEVEL |
5882 |
C ----------------- |
5883 |
C |
5884 |
2250 CONTINUE |
5885 |
C |
5886 |
DO 228 JK=3,KFLEV+1 |
5887 |
IKN=(JK-1)*NG1P1+1 |
5888 |
IKM1=JK-1 |
5889 |
IKJ=JK-2 |
5890 |
IKU1= IKJ *NG1P1+1 |
5891 |
C |
5892 |
C |
5893 |
CALL LWTTM(PGA(1,1,1,IKJ),PGB(1,1,1,IKJ) |
5894 |
2 , PABCU(1,1,IKU1),PABCU(1,1,IKN),ZTT1) |
5895 |
C |
5896 |
C |
5897 |
C |
5898 |
C* 2.2.6 DOWN BELOW |
5899 |
C ---------- |
5900 |
C |
5901 |
2260 CONTINUE |
5902 |
C |
5903 |
ITT=1 |
5904 |
DO 227 JLK=1,IKJ |
5905 |
IF(ITT.EQ.1) THEN |
5906 |
ITT=2 |
5907 |
ELSE |
5908 |
ITT=1 |
5909 |
ENDIF |
5910 |
IJKL=IKM1-JLK |
5911 |
IKU2=(IJKL-1)*NG1P1+1 |
5912 |
C |
5913 |
C |
5914 |
IF(ITT.EQ.1) THEN |
5915 |
CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL) |
5916 |
2 , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT1) |
5917 |
ELSE |
5918 |
CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL) |
5919 |
2 , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT2) |
5920 |
ENDIF |
5921 |
C |
5922 |
DO 2265 JA = 1, KTRAER |
5923 |
DO 2264 JL = 1, KDLON |
5924 |
ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5 |
5925 |
2264 CONTINUE |
5926 |
2265 CONTINUE |
5927 |
C |
5928 |
DO 2266 JL = 1, KDLON |
5929 |
ZWW=PDBDT(JL,1,IJKL)*ZTT(JL,1) *ZTT(JL,10) |
5930 |
S +PDBDT(JL,2,IJKL)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
5931 |
S +PDBDT(JL,3,IJKL)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
5932 |
S +PDBDT(JL,4,IJKL)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
5933 |
S +PDBDT(JL,5,IJKL)*ZTT(JL,3) *ZTT(JL,14) |
5934 |
S +PDBDT(JL,6,IJKL)*ZTT(JL,6) *ZTT(JL,15) |
5935 |
ZGLAYU(JL)=ZWW |
5936 |
ZDZXMG=ZGLAYU(JL) |
5937 |
PDISU(JL,JK)=PDISU(JL,JK)+ZDZXMG |
5938 |
PCNTRB(JL,JK,IJKL)=ZDZXMG |
5939 |
2266 CONTINUE |
5940 |
C |
5941 |
C |
5942 |
227 CONTINUE |
5943 |
228 CONTINUE |
5944 |
C |
5945 |
RETURN |
5946 |
END |
5947 |
SUBROUTINE LWVN(KUAER,KTRAER |
5948 |
R , PABCU,PDBSL,PGA,PGB |
5949 |
S , PADJD,PADJU,PCNTRB,PDBDT) |
5950 |
use dimens_m |
5951 |
use dimphy |
5952 |
use raddim |
5953 |
IMPLICIT none |
5954 |
include "raddimlw.h" |
5955 |
C |
5956 |
C----------------------------------------------------------------------- |
5957 |
C PURPOSE. |
5958 |
C -------- |
5959 |
C CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS |
5960 |
C TO GIVE LONGWAVE FLUXES OR RADIANCES |
5961 |
C |
5962 |
C METHOD. |
5963 |
C ------- |
5964 |
C |
5965 |
C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE |
5966 |
C CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE |
5967 |
C |
5968 |
C REFERENCE. |
5969 |
C ---------- |
5970 |
C |
5971 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
5972 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
5973 |
C |
5974 |
C AUTHOR. |
5975 |
C ------- |
5976 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
5977 |
C |
5978 |
C MODIFICATIONS. |
5979 |
C -------------- |
5980 |
C ORIGINAL : 89-07-14 |
5981 |
C----------------------------------------------------------------------- |
5982 |
C |
5983 |
C* ARGUMENTS: |
5984 |
C |
5985 |
INTEGER KUAER,KTRAER |
5986 |
C |
5987 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS |
5988 |
REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
5989 |
REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5990 |
REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
5991 |
C |
5992 |
REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS |
5993 |
REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS |
5994 |
REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX |
5995 |
REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT |
5996 |
C |
5997 |
C* LOCAL ARRAYS: |
5998 |
C |
5999 |
REAL*8 ZGLAYD(KDLON) |
6000 |
REAL*8 ZGLAYU(KDLON) |
6001 |
REAL*8 ZTT(KDLON,NTRA) |
6002 |
REAL*8 ZTT1(KDLON,NTRA) |
6003 |
REAL*8 ZTT2(KDLON,NTRA) |
6004 |
REAL*8 ZUU(KDLON,NUA) |
6005 |
C |
6006 |
INTEGER jk, jl, ja, im12, ind, inu, ixu, jg |
6007 |
INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu |
6008 |
REAL*8 zwtr |
6009 |
c |
6010 |
C* Data Block: |
6011 |
c |
6012 |
REAL*8 WG1(2) |
6013 |
SAVE WG1 |
6014 |
DATA (WG1(jk),jk=1,2) /1.0, 1.0/ |
6015 |
C----------------------------------------------------------------------- |
6016 |
C |
6017 |
C* 1. INITIALIZATION |
6018 |
C -------------- |
6019 |
C |
6020 |
100 CONTINUE |
6021 |
C |
6022 |
C* 1.1 INITIALIZE LAYER CONTRIBUTIONS |
6023 |
C ------------------------------ |
6024 |
C |
6025 |
110 CONTINUE |
6026 |
C |
6027 |
DO 112 JK = 1 , KFLEV+1 |
6028 |
DO 111 JL = 1, KDLON |
6029 |
PADJD(JL,JK) = 0. |
6030 |
PADJU(JL,JK) = 0. |
6031 |
111 CONTINUE |
6032 |
112 CONTINUE |
6033 |
C |
6034 |
C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
6035 |
C --------------------------------- |
6036 |
C |
6037 |
120 CONTINUE |
6038 |
C |
6039 |
DO 122 JA = 1 , NTRA |
6040 |
DO 121 JL = 1, KDLON |
6041 |
ZTT (JL,JA) = 1.0 |
6042 |
ZTT1(JL,JA) = 1.0 |
6043 |
ZTT2(JL,JA) = 1.0 |
6044 |
121 CONTINUE |
6045 |
122 CONTINUE |
6046 |
C |
6047 |
DO 124 JA = 1 , NUA |
6048 |
DO 123 JL = 1, KDLON |
6049 |
ZUU(JL,JA) = 0. |
6050 |
123 CONTINUE |
6051 |
124 CONTINUE |
6052 |
C |
6053 |
C ------------------------------------------------------------------ |
6054 |
C |
6055 |
C* 2. VERTICAL INTEGRATION |
6056 |
C -------------------- |
6057 |
C |
6058 |
200 CONTINUE |
6059 |
C |
6060 |
C |
6061 |
C* 2.1 CONTRIBUTION FROM ADJACENT LAYERS |
6062 |
C --------------------------------- |
6063 |
C |
6064 |
210 CONTINUE |
6065 |
C |
6066 |
DO 215 JK = 1 , KFLEV |
6067 |
C |
6068 |
C* 2.1.1 DOWNWARD LAYERS |
6069 |
C --------------- |
6070 |
C |
6071 |
2110 CONTINUE |
6072 |
C |
6073 |
IM12 = 2 * (JK - 1) |
6074 |
IND = (JK - 1) * NG1P1 + 1 |
6075 |
IXD = IND |
6076 |
INU = JK * NG1P1 + 1 |
6077 |
IXU = IND |
6078 |
C |
6079 |
DO 2111 JL = 1, KDLON |
6080 |
ZGLAYD(JL) = 0. |
6081 |
ZGLAYU(JL) = 0. |
6082 |
2111 CONTINUE |
6083 |
C |
6084 |
DO 213 JG = 1 , NG1 |
6085 |
IBS = IM12 + JG |
6086 |
IDD = IXD + JG |
6087 |
DO 2113 JA = 1 , KUAER |
6088 |
DO 2112 JL = 1, KDLON |
6089 |
ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD) |
6090 |
2112 CONTINUE |
6091 |
2113 CONTINUE |
6092 |
C |
6093 |
C |
6094 |
CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT) |
6095 |
C |
6096 |
DO 2114 JL = 1, KDLON |
6097 |
ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1) *ZTT(JL,10) |
6098 |
S +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
6099 |
S +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
6100 |
S +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
6101 |
S +PDBSL(JL,5,IBS)*ZTT(JL,3) *ZTT(JL,14) |
6102 |
S +PDBSL(JL,6,IBS)*ZTT(JL,6) *ZTT(JL,15) |
6103 |
ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG1(JG) |
6104 |
2114 CONTINUE |
6105 |
C |
6106 |
C* 2.1.2 DOWNWARD LAYERS |
6107 |
C --------------- |
6108 |
C |
6109 |
2120 CONTINUE |
6110 |
C |
6111 |
IMU = IXU + JG |
6112 |
DO 2122 JA = 1 , KUAER |
6113 |
DO 2121 JL = 1, KDLON |
6114 |
ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU) |
6115 |
2121 CONTINUE |
6116 |
2122 CONTINUE |
6117 |
C |
6118 |
C |
6119 |
CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT) |
6120 |
C |
6121 |
DO 2123 JL = 1, KDLON |
6122 |
ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1) *ZTT(JL,10) |
6123 |
S +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
6124 |
S +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
6125 |
S +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
6126 |
S +PDBSL(JL,5,IBS)*ZTT(JL,3) *ZTT(JL,14) |
6127 |
S +PDBSL(JL,6,IBS)*ZTT(JL,6) *ZTT(JL,15) |
6128 |
ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG1(JG) |
6129 |
2123 CONTINUE |
6130 |
C |
6131 |
213 CONTINUE |
6132 |
C |
6133 |
DO 214 JL = 1, KDLON |
6134 |
PADJD(JL,JK) = ZGLAYD(JL) |
6135 |
PCNTRB(JL,JK,JK+1) = ZGLAYD(JL) |
6136 |
PADJU(JL,JK+1) = ZGLAYU(JL) |
6137 |
PCNTRB(JL,JK+1,JK) = ZGLAYU(JL) |
6138 |
PCNTRB(JL,JK ,JK) = 0.0 |
6139 |
214 CONTINUE |
6140 |
C |
6141 |
215 CONTINUE |
6142 |
C |
6143 |
DO 218 JK = 1 , KFLEV |
6144 |
JK2 = 2 * JK |
6145 |
JK1 = JK2 - 1 |
6146 |
DO 217 JNU = 1 , Ninter |
6147 |
DO 216 JL = 1, KDLON |
6148 |
PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2) |
6149 |
216 CONTINUE |
6150 |
217 CONTINUE |
6151 |
218 CONTINUE |
6152 |
C |
6153 |
RETURN |
6154 |
C |
6155 |
END |
6156 |
SUBROUTINE LWTT(PGA,PGB,PUU, PTT) |
6157 |
use dimens_m |
6158 |
use dimphy |
6159 |
use raddim |
6160 |
IMPLICIT none |
6161 |
include "raddimlw.h" |
6162 |
C |
6163 |
C----------------------------------------------------------------------- |
6164 |
C PURPOSE. |
6165 |
C -------- |
6166 |
C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
6167 |
C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL |
6168 |
C INTERVALS. |
6169 |
C |
6170 |
C METHOD. |
6171 |
C ------- |
6172 |
C |
6173 |
C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE |
6174 |
C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM. |
6175 |
C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL. |
6176 |
C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN |
6177 |
C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT. |
6178 |
C |
6179 |
C REFERENCE. |
6180 |
C ---------- |
6181 |
C |
6182 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
6183 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
6184 |
C |
6185 |
C AUTHOR. |
6186 |
C ------- |
6187 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
6188 |
C |
6189 |
C MODIFICATIONS. |
6190 |
C -------------- |
6191 |
C ORIGINAL : 88-12-15 |
6192 |
C |
6193 |
C----------------------------------------------------------------------- |
6194 |
REAL*8 O1H, O2H |
6195 |
PARAMETER (O1H=2230.) |
6196 |
PARAMETER (O2H=100.) |
6197 |
REAL*8 RPIALF0 |
6198 |
PARAMETER (RPIALF0=2.0) |
6199 |
C |
6200 |
C* ARGUMENTS: |
6201 |
C |
6202 |
REAL*8 PUU(KDLON,NUA) |
6203 |
REAL*8 PTT(KDLON,NTRA) |
6204 |
REAL*8 PGA(KDLON,8,2) |
6205 |
REAL*8 PGB(KDLON,8,2) |
6206 |
C |
6207 |
C* LOCAL VARIABLES: |
6208 |
C |
6209 |
REAL*8 zz, zxd, zxn |
6210 |
REAL*8 zpu, zpu10, zpu11, zpu12, zpu13 |
6211 |
REAL*8 zeu, zeu10, zeu11, zeu12, zeu13 |
6212 |
REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy |
6213 |
REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o |
6214 |
REAL*8 zsqn21, zodn21, zsqh42, zodh42 |
6215 |
REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12 |
6216 |
REAL*8 zuu11, zuu12, za11, za12 |
6217 |
INTEGER jl, ja |
6218 |
C ------------------------------------------------------------------ |
6219 |
C |
6220 |
C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION |
6221 |
C ----------------------------------------------- |
6222 |
C |
6223 |
100 CONTINUE |
6224 |
C |
6225 |
C |
6226 |
DO 130 JA = 1 , 8 |
6227 |
DO 120 JL = 1, KDLON |
6228 |
ZZ =SQRT(PUU(JL,JA)) |
6229 |
c ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1)) |
6230 |
c ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) ) |
6231 |
c PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1) |
6232 |
ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ ) |
6233 |
ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) ) |
6234 |
PTT(JL,JA)=ZXN /ZXD |
6235 |
120 CONTINUE |
6236 |
130 CONTINUE |
6237 |
C |
6238 |
C ------------------------------------------------------------------ |
6239 |
C |
6240 |
C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS |
6241 |
C --------------------------------------------------- |
6242 |
C |
6243 |
200 CONTINUE |
6244 |
C |
6245 |
DO 201 JL = 1, KDLON |
6246 |
PTT(JL, 9) = PTT(JL, 8) |
6247 |
C |
6248 |
C- CONTINUUM ABSORPTION: E- AND P-TYPE |
6249 |
C |
6250 |
ZPU = 0.002 * PUU(JL,10) |
6251 |
ZPU10 = 112. * ZPU |
6252 |
ZPU11 = 6.25 * ZPU |
6253 |
ZPU12 = 5.00 * ZPU |
6254 |
ZPU13 = 80.0 * ZPU |
6255 |
ZEU = PUU(JL,11) |
6256 |
ZEU10 = 12. * ZEU |
6257 |
ZEU11 = 6.25 * ZEU |
6258 |
ZEU12 = 5.00 * ZEU |
6259 |
ZEU13 = 80.0 * ZEU |
6260 |
C |
6261 |
C- OZONE ABSORPTION |
6262 |
C |
6263 |
ZX = PUU(JL,12) |
6264 |
ZY = PUU(JL,13) |
6265 |
ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY) |
6266 |
ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1. |
6267 |
ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1. |
6268 |
ZVXY = RPIALF0 * ZY / (2. * ZX) |
6269 |
ZAERCN = PUU(JL,17) + ZEU12 + ZPU12 |
6270 |
ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN ) |
6271 |
ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN ) |
6272 |
C |
6273 |
C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12) |
6274 |
C |
6275 |
C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1 |
6276 |
C |
6277 |
c NEXOTIC=1 |
6278 |
c IF (NEXOTIC.EQ.1) THEN |
6279 |
ZXCH4 = PUU(JL,19) |
6280 |
ZYCH4 = PUU(JL,20) |
6281 |
ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4) |
6282 |
ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1. |
6283 |
ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4) |
6284 |
ZODH41 = ZVXY * ZSQH41 |
6285 |
C |
6286 |
C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1 |
6287 |
C |
6288 |
ZXN2O = PUU(JL,21) |
6289 |
ZYN2O = PUU(JL,22) |
6290 |
ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O) |
6291 |
ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1. |
6292 |
ZVXY = 0.416 * ZYN2O / (2. * ZXN2O) |
6293 |
ZODN21 = ZVXY * ZSQN21 |
6294 |
C |
6295 |
C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
6296 |
C |
6297 |
ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4) |
6298 |
ZSQH42 = SQRT(1. + 400. * ZUXY) - 1. |
6299 |
ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4) |
6300 |
ZODH42 = ZVXY * ZSQH42 |
6301 |
C |
6302 |
C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
6303 |
C |
6304 |
ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O) |
6305 |
ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1. |
6306 |
ZVXY = 0.197 * ZYN2O / (2. * ZXN2O) |
6307 |
ZODN22 = ZVXY * ZSQN22 |
6308 |
C |
6309 |
C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1 |
6310 |
C |
6311 |
ZA11 = 2. * PUU(JL,23) * 4.404E+05 |
6312 |
ZTTF11 = 1. - ZA11 * 0.003225 |
6313 |
C |
6314 |
C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1 |
6315 |
C |
6316 |
ZA12 = 2. * PUU(JL,24) * 6.7435E+05 |
6317 |
ZTTF12 = 1. - ZA12 * 0.003225 |
6318 |
C |
6319 |
ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10 |
6320 |
ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21 |
6321 |
PTT(JL,10) = EXP( - PUU(JL,14) ) |
6322 |
PTT(JL,11) = EXP( ZUU11 ) |
6323 |
PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12 |
6324 |
PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2 |
6325 |
PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 ) |
6326 |
PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 ) |
6327 |
201 CONTINUE |
6328 |
C |
6329 |
RETURN |
6330 |
END |
6331 |
SUBROUTINE LWTTM(PGA,PGB,PUU1,PUU2, PTT) |
6332 |
use dimens_m |
6333 |
use dimphy |
6334 |
use raddim |
6335 |
IMPLICIT none |
6336 |
include "raddimlw.h" |
6337 |
C |
6338 |
C ------------------------------------------------------------------ |
6339 |
C PURPOSE. |
6340 |
C -------- |
6341 |
C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
6342 |
C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL |
6343 |
C INTERVALS. |
6344 |
C |
6345 |
C METHOD. |
6346 |
C ------- |
6347 |
C |
6348 |
C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE |
6349 |
C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM. |
6350 |
C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL. |
6351 |
C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN |
6352 |
C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT. |
6353 |
C |
6354 |
C REFERENCE. |
6355 |
C ---------- |
6356 |
C |
6357 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
6358 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
6359 |
C |
6360 |
C AUTHOR. |
6361 |
C ------- |
6362 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
6363 |
C |
6364 |
C MODIFICATIONS. |
6365 |
C -------------- |
6366 |
C ORIGINAL : 88-12-15 |
6367 |
C |
6368 |
C----------------------------------------------------------------------- |
6369 |
REAL*8 O1H, O2H |
6370 |
PARAMETER (O1H=2230.) |
6371 |
PARAMETER (O2H=100.) |
6372 |
REAL*8 RPIALF0 |
6373 |
PARAMETER (RPIALF0=2.0) |
6374 |
C |
6375 |
C* ARGUMENTS: |
6376 |
C |
6377 |
REAL*8 PGA(KDLON,8,2) ! PADE APPROXIMANTS |
6378 |
REAL*8 PGB(KDLON,8,2) ! PADE APPROXIMANTS |
6379 |
REAL*8 PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1 |
6380 |
REAL*8 PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2 |
6381 |
REAL*8 PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS |
6382 |
C |
6383 |
C* LOCAL VARIABLES: |
6384 |
C |
6385 |
INTEGER ja, jl |
6386 |
REAL*8 zz, zxd, zxn |
6387 |
REAL*8 zpu, zpu10, zpu11, zpu12, zpu13 |
6388 |
REAL*8 zeu, zeu10, zeu11, zeu12, zeu13 |
6389 |
REAL*8 zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2 |
6390 |
REAL*8 zxch4, zych4, zsqh41, zodh41 |
6391 |
REAL*8 zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42 |
6392 |
REAL*8 zsqn22, zodn22, za11, zttf11, za12, zttf12 |
6393 |
REAL*8 zuu11, zuu12 |
6394 |
C ------------------------------------------------------------------ |
6395 |
C |
6396 |
C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION |
6397 |
C ----------------------------------------------- |
6398 |
C |
6399 |
100 CONTINUE |
6400 |
C |
6401 |
C |
6402 |
DO 130 JA = 1 , 8 |
6403 |
DO 120 JL = 1, KDLON |
6404 |
ZZ =SQRT(PUU1(JL,JA) - PUU2(JL,JA)) |
6405 |
ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ ) |
6406 |
ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) ) |
6407 |
PTT(JL,JA)=ZXN /ZXD |
6408 |
120 CONTINUE |
6409 |
130 CONTINUE |
6410 |
C |
6411 |
C ------------------------------------------------------------------ |
6412 |
C |
6413 |
C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS |
6414 |
C --------------------------------------------------- |
6415 |
C |
6416 |
200 CONTINUE |
6417 |
C |
6418 |
DO 201 JL = 1, KDLON |
6419 |
PTT(JL, 9) = PTT(JL, 8) |
6420 |
C |
6421 |
C- CONTINUUM ABSORPTION: E- AND P-TYPE |
6422 |
C |
6423 |
ZPU = 0.002 * (PUU1(JL,10) - PUU2(JL,10)) |
6424 |
ZPU10 = 112. * ZPU |
6425 |
ZPU11 = 6.25 * ZPU |
6426 |
ZPU12 = 5.00 * ZPU |
6427 |
ZPU13 = 80.0 * ZPU |
6428 |
ZEU = (PUU1(JL,11) - PUU2(JL,11)) |
6429 |
ZEU10 = 12. * ZEU |
6430 |
ZEU11 = 6.25 * ZEU |
6431 |
ZEU12 = 5.00 * ZEU |
6432 |
ZEU13 = 80.0 * ZEU |
6433 |
C |
6434 |
C- OZONE ABSORPTION |
6435 |
C |
6436 |
ZX = (PUU1(JL,12) - PUU2(JL,12)) |
6437 |
ZY = (PUU1(JL,13) - PUU2(JL,13)) |
6438 |
ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY) |
6439 |
ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1. |
6440 |
ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1. |
6441 |
ZVXY = RPIALF0 * ZY / (2. * ZX) |
6442 |
ZAERCN = (PUU1(JL,17) -PUU2(JL,17)) + ZEU12 + ZPU12 |
6443 |
ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN ) |
6444 |
ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN ) |
6445 |
C |
6446 |
C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12) |
6447 |
C |
6448 |
C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1 |
6449 |
C |
6450 |
ZXCH4 = (PUU1(JL,19) - PUU2(JL,19)) |
6451 |
ZYCH4 = (PUU1(JL,20) - PUU2(JL,20)) |
6452 |
ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4) |
6453 |
ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1. |
6454 |
ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4) |
6455 |
ZODH41 = ZVXY * ZSQH41 |
6456 |
C |
6457 |
C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1 |
6458 |
C |
6459 |
ZXN2O = (PUU1(JL,21) - PUU2(JL,21)) |
6460 |
ZYN2O = (PUU1(JL,22) - PUU2(JL,22)) |
6461 |
ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O) |
6462 |
ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1. |
6463 |
ZVXY = 0.416 * ZYN2O / (2. * ZXN2O) |
6464 |
ZODN21 = ZVXY * ZSQN21 |
6465 |
C |
6466 |
C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
6467 |
C |
6468 |
ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4) |
6469 |
ZSQH42 = SQRT(1. + 400. * ZUXY) - 1. |
6470 |
ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4) |
6471 |
ZODH42 = ZVXY * ZSQH42 |
6472 |
C |
6473 |
C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
6474 |
C |
6475 |
ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O) |
6476 |
ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1. |
6477 |
ZVXY = 0.197 * ZYN2O / (2. * ZXN2O) |
6478 |
ZODN22 = ZVXY * ZSQN22 |
6479 |
C |
6480 |
C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1 |
6481 |
C |
6482 |
ZA11 = (PUU1(JL,23) - PUU2(JL,23)) * 4.404E+05 |
6483 |
ZTTF11 = 1. - ZA11 * 0.003225 |
6484 |
C |
6485 |
C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1 |
6486 |
C |
6487 |
ZA12 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05 |
6488 |
ZTTF12 = 1. - ZA12 * 0.003225 |
6489 |
C |
6490 |
ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10 |
6491 |
ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 - |
6492 |
S ZODH41 - ZODN21 |
6493 |
PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(JL,14)) ) |
6494 |
PTT(JL,11) = EXP( ZUU11 ) |
6495 |
PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12 |
6496 |
PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2 |
6497 |
PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 ) |
6498 |
PTT(JL,15) = EXP ( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 ) |
6499 |
201 CONTINUE |
6500 |
C |
6501 |
RETURN |
6502 |
END |