1 | ! |
---|
2 | ! $Header$ |
---|
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 | IMPLICIT none |
---|
20 | c====================================================================== |
---|
21 | c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719 |
---|
22 | c Objet: interface entre le modele et les rayonnements |
---|
23 | c Arguments: |
---|
24 | c dist-----input-R- distance astronomique terre-soleil |
---|
25 | c rmu0-----input-R- cosinus de l'angle zenithal |
---|
26 | c fract----input-R- duree d'ensoleillement normalisee |
---|
27 | c co2_ppm--input-R- concentration du gaz carbonique (en ppm) |
---|
28 | c solaire--input-R- constante solaire (W/m**2) |
---|
29 | c paprs----input-R- pression a inter-couche (Pa) |
---|
30 | c pplay----input-R- pression au milieu de couche (Pa) |
---|
31 | c tsol-----input-R- temperature du sol (en K) |
---|
32 | c albedo---input-R- albedo du sol (entre 0 et 1) |
---|
33 | c t--------input-R- temperature (K) |
---|
34 | c q--------input-R- vapeur d'eau (en kg/kg) |
---|
35 | c wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505 |
---|
36 | c cldfra---input-R- fraction nuageuse (entre 0 et 1) |
---|
37 | c cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value) |
---|
38 | c cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1) |
---|
39 | c ok_ade---input-L- apply the Aerosol Direct Effect or not? |
---|
40 | c ok_aie---input-L- apply the Aerosol Indirect Effect or not? |
---|
41 | c tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F) |
---|
42 | c cldtaupi-input-R- epaisseur optique des nuages dans le visible |
---|
43 | c calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller |
---|
44 | c droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd |
---|
45 | c it is needed for the diagnostics of the aerosol indirect radiative forcing |
---|
46 | c |
---|
47 | c heat-----output-R- echauffement atmospherique (visible) (K/jour) |
---|
48 | c cool-----output-R- refroidissement dans l'IR (K/jour) |
---|
49 | c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas) |
---|
50 | c albpla---output-R- albedo planetaire (entre 0 et 1) |
---|
51 | c topsw----output-R- flux solaire net au sommet de l'atm. |
---|
52 | c toplw----output-R- ray. IR montant au sommet de l'atmosphere |
---|
53 | c solsw----output-R- flux solaire net a la surface |
---|
54 | c sollw----output-R- ray. IR montant a la surface |
---|
55 | c solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) |
---|
56 | c topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir) |
---|
57 | c solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind) |
---|
58 | c topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind) |
---|
59 | c |
---|
60 | c ATTENTION: swai and swad have to be interpreted in the following manner: |
---|
61 | c --------- |
---|
62 | c ok_ade=F & ok_aie=F -both are zero |
---|
63 | c ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad |
---|
64 | c indirect is zero |
---|
65 | c ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai |
---|
66 | c direct is zero |
---|
67 | c ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai |
---|
68 | c aerosol direct forcing is F_{AD} = topswai-topswad |
---|
69 | c |
---|
70 | |
---|
71 | c====================================================================== |
---|
72 | cym#include "dimensions.h" |
---|
73 | cym#include "dimphy.h" |
---|
74 | cym#include "raddim.h" |
---|
75 | #include "YOETHF.h" |
---|
76 | c |
---|
77 | real rmu0(klon), fract(klon), dist |
---|
78 | cIM real co2_ppm |
---|
79 | cIM real solaire |
---|
80 | #include "clesphys.h" |
---|
81 | c |
---|
82 | real paprs(klon,klev+1), pplay(klon,klev) |
---|
83 | real albedo(klon), alblw(klon), tsol(klon) |
---|
84 | real t(klon,klev), q(klon,klev), wo(klon,klev) |
---|
85 | real cldfra(klon,klev), cldemi(klon,klev), cldtaupd(klon,klev) |
---|
86 | real heat(klon,klev), cool(klon,klev) |
---|
87 | real heat0(klon,klev), cool0(klon,klev) |
---|
88 | real radsol(klon), topsw(klon), toplw(klon) |
---|
89 | real solsw(klon), sollw(klon), albpla(klon) |
---|
90 | real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon) |
---|
91 | real sollwdown(klon) |
---|
92 | cIM output 3D |
---|
93 | REAL*8 ZFSUP(KDLON,KFLEV+1) |
---|
94 | REAL*8 ZFSDN(KDLON,KFLEV+1) |
---|
95 | REAL*8 ZFSUP0(KDLON,KFLEV+1) |
---|
96 | REAL*8 ZFSDN0(KDLON,KFLEV+1) |
---|
97 | c |
---|
98 | REAL*8 ZFLUP(KDLON,KFLEV+1) |
---|
99 | REAL*8 ZFLDN(KDLON,KFLEV+1) |
---|
100 | REAL*8 ZFLUP0(KDLON,KFLEV+1) |
---|
101 | REAL*8 ZFLDN0(KDLON,KFLEV+1) |
---|
102 | c |
---|
103 | REAL*8 zx_alpha1, zx_alpha2 |
---|
104 | c |
---|
105 | #include "YOMCST.h" |
---|
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 | CALL abort |
---|
173 | ENDIF |
---|
174 | IF (kflev .NE. klev) THEN |
---|
175 | PRINT*, "kflev differe de klev, kflev, klev" |
---|
176 | CALL abort |
---|
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 | POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968 |
---|
242 | . /(paprs(iof+i,k)-paprs(iof+i,k+1)) |
---|
243 | . *(paprs(iof+i,1)/101325.0) |
---|
244 | PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) |
---|
245 | PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) |
---|
246 | PCLDSW(i,k) = cldfra(iof+i,k) |
---|
247 | PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable |
---|
248 | PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines |
---|
249 | POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k)) |
---|
250 | POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k)) |
---|
251 | PCG(i,1,k) = 0.865 |
---|
252 | PCG(i,2,k) = 0.910 |
---|
253 | c-OB |
---|
254 | cjq Introduced for aerosol indirect forcings. |
---|
255 | cjq The following values use the cloud optical thickness calculated from |
---|
256 | cjq present-day aerosol concentrations whereas the quantities without the |
---|
257 | cjq "A" at the end are for pre-industial (natural-only) aerosol concentrations |
---|
258 | cjq |
---|
259 | PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable |
---|
260 | PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines |
---|
261 | POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k)) |
---|
262 | POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k)) |
---|
263 | cjq-end |
---|
264 | ENDDO |
---|
265 | ENDDO |
---|
266 | c |
---|
267 | DO k = 1, kflev+1 |
---|
268 | DO i = 1, kdlon |
---|
269 | PPMB(i,k) = paprs(iof+i,k)/100.0 |
---|
270 | ENDDO |
---|
271 | ENDDO |
---|
272 | c |
---|
273 | DO kk = 1, 5 |
---|
274 | DO k = 1, kflev |
---|
275 | DO i = 1, kdlon |
---|
276 | PAER(i,k,kk) = 1.0E-15 |
---|
277 | ENDDO |
---|
278 | ENDDO |
---|
279 | ENDDO |
---|
280 | c-OB |
---|
281 | DO k = 1, kflev |
---|
282 | DO i = 1, kdlon |
---|
283 | tauae(i,k,1)=tau_ae(iof+i,k,1) |
---|
284 | pizae(i,k,1)=piz_ae(iof+i,k,1) |
---|
285 | cgae(i,k,1) =cg_ae(iof+i,k,1) |
---|
286 | tauae(i,k,2)=tau_ae(iof+i,k,2) |
---|
287 | pizae(i,k,2)=piz_ae(iof+i,k,2) |
---|
288 | cgae(i,k,2) =cg_ae(iof+i,k,2) |
---|
289 | ENDDO |
---|
290 | ENDDO |
---|
291 | c |
---|
292 | c====================================================================== |
---|
293 | cIM ctes ds clesphys.h CALL LW(RCO2,RCH4,RN2O,RCFC11,RCFC12, |
---|
294 | CALL LW( |
---|
295 | . PPMB, PDP, |
---|
296 | . PPSOL,PDT0,PEMIS, |
---|
297 | . PTL, PTAVE, PWV, POZON, PAER, |
---|
298 | . PCLDLD,PCLDLU, |
---|
299 | . PVIEW, |
---|
300 | . zcool, zcool0, |
---|
301 | . ztoplw,zsollw,ztoplw0,zsollw0, |
---|
302 | . zsollwdown, |
---|
303 | . ZFLUP, ZFLDN, ZFLUP0,ZFLDN0) |
---|
304 | cIM ctes ds clesphys.h CALL SW(PSCT, RCO2, zrmu0, zfract, |
---|
305 | CALL SW(PSCT, zrmu0, zfract, |
---|
306 | S PPMB, PDP, |
---|
307 | S PPSOL, PALBD, PALBP, |
---|
308 | S PTAVE, PWV, PQS, POZON, PAER, |
---|
309 | S PCLDSW, PTAU, POMEGA, PCG, |
---|
310 | S zheat, zheat0, |
---|
311 | S zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0, |
---|
312 | S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, |
---|
313 | S tauae, pizae, cgae, ! aerosol optical properties |
---|
314 | s PTAUA, POMEGAA, |
---|
315 | s ztopswad,zsolswad,ztopswai,zsolswai, ! diagnosed aerosol forcing |
---|
316 | J ok_ade, ok_aie) ! apply aerosol effects or not? |
---|
317 | |
---|
318 | c====================================================================== |
---|
319 | DO i = 1, kdlon |
---|
320 | radsol(iof+i) = zsolsw(i) + zsollw(i) |
---|
321 | topsw(iof+i) = ztopsw(i) |
---|
322 | toplw(iof+i) = ztoplw(i) |
---|
323 | solsw(iof+i) = zsolsw(i) |
---|
324 | sollw(iof+i) = zsollw(i) |
---|
325 | sollwdown(iof+i) = zsollwdown(i) |
---|
326 | cIM |
---|
327 | DO k = 1, kflev+1 |
---|
328 | lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) |
---|
329 | lwdn ( iof+i,k) = ZFLDN ( i,k) |
---|
330 | lwup0 ( iof+i,k) = ZFLUP0 ( i,k) |
---|
331 | lwup ( iof+i,k) = ZFLUP ( i,k) |
---|
332 | ENDDO |
---|
333 | c |
---|
334 | topsw0(iof+i) = ztopsw0(i) |
---|
335 | toplw0(iof+i) = ztoplw0(i) |
---|
336 | solsw0(iof+i) = zsolsw0(i) |
---|
337 | sollw0(iof+i) = zsollw0(i) |
---|
338 | albpla(iof+i) = zalbpla(i) |
---|
339 | cIM |
---|
340 | DO k = 1, kflev+1 |
---|
341 | swdn0 ( iof+i,k) = ZFSDN0 ( i,k) |
---|
342 | swdn ( iof+i,k) = ZFSDN ( i,k) |
---|
343 | swup0 ( iof+i,k) = ZFSUP0 ( i,k) |
---|
344 | swup ( iof+i,k) = ZFSUP ( i,k) |
---|
345 | ENDDO !k=1, kflev+1 |
---|
346 | ENDDO |
---|
347 | cjq-transform the aerosol forcings, if they have |
---|
348 | cjq to be calculated |
---|
349 | IF (ok_ade) THEN |
---|
350 | DO i = 1, kdlon |
---|
351 | topswad(iof+i) = ztopswad(i) |
---|
352 | solswad(iof+i) = zsolswad(i) |
---|
353 | ENDDO |
---|
354 | ELSE |
---|
355 | DO i = 1, kdlon |
---|
356 | topswad(iof+i) = 0.0 |
---|
357 | solswad(iof+i) = 0.0 |
---|
358 | ENDDO |
---|
359 | ENDIF |
---|
360 | IF (ok_aie) THEN |
---|
361 | DO i = 1, kdlon |
---|
362 | topswai(iof+i) = ztopswai(i) |
---|
363 | solswai(iof+i) = zsolswai(i) |
---|
364 | ENDDO |
---|
365 | ELSE |
---|
366 | DO i = 1, kdlon |
---|
367 | topswai(iof+i) = 0.0 |
---|
368 | solswai(iof+i) = 0.0 |
---|
369 | ENDDO |
---|
370 | ENDIF |
---|
371 | cjq-end |
---|
372 | DO k = 1, kflev |
---|
373 | c DO i = 1, kdlon |
---|
374 | c heat(iof+i,k) = zheat(i,k) |
---|
375 | c cool(iof+i,k) = zcool(i,k) |
---|
376 | c heat0(iof+i,k) = zheat0(i,k) |
---|
377 | c cool0(iof+i,k) = zcool0(i,k) |
---|
378 | c ENDDO |
---|
379 | DO i = 1, kdlon |
---|
380 | C scale factor to take into account the difference between |
---|
381 | C dry air and watter vapour scpecific heat capacity |
---|
382 | zznormcp=1.0+RVTMP2*PWV(i,k) |
---|
383 | heat(iof+i,k) = zheat(i,k)/zznormcp |
---|
384 | cool(iof+i,k) = zcool(i,k)/zznormcp |
---|
385 | heat0(iof+i,k) = zheat0(i,k)/zznormcp |
---|
386 | cool0(iof+i,k) = zcool0(i,k)/zznormcp |
---|
387 | ENDDO |
---|
388 | ENDDO |
---|
389 | c |
---|
390 | 99999 CONTINUE |
---|
391 | RETURN |
---|
392 | END |
---|
393 | cIM ctes ds clesphys.h SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC, |
---|
394 | SUBROUTINE SW(PSCT, PRMU0, PFRAC, |
---|
395 | S PPMB, PDP, |
---|
396 | S PPSOL, PALBD, PALBP, |
---|
397 | S PTAVE, PWV, PQS, POZON, PAER, |
---|
398 | S PCLDSW, PTAU, POMEGA, PCG, |
---|
399 | S PHEAT, PHEAT0, |
---|
400 | S PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0, |
---|
401 | S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, |
---|
402 | S tauae, pizae, cgae, |
---|
403 | s PTAUA, POMEGAA, |
---|
404 | S PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI, |
---|
405 | J ok_ade, ok_aie ) |
---|
406 | USE dimphy |
---|
407 | IMPLICIT none |
---|
408 | |
---|
409 | cym#include "dimensions.h" |
---|
410 | cym#include "dimphy.h" |
---|
411 | cym#include "raddim.h" |
---|
412 | #include "YOMCST.h" |
---|
413 | C |
---|
414 | C ------------------------------------------------------------------ |
---|
415 | C |
---|
416 | C PURPOSE. |
---|
417 | C -------- |
---|
418 | C |
---|
419 | C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO |
---|
420 | C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
---|
421 | C |
---|
422 | C METHOD. |
---|
423 | C ------- |
---|
424 | C |
---|
425 | C 1. COMPUTES ABSORBER AMOUNTS (SWU) |
---|
426 | C 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S) |
---|
427 | C 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S) |
---|
428 | C |
---|
429 | C REFERENCE. |
---|
430 | C ---------- |
---|
431 | C |
---|
432 | C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
---|
433 | C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
---|
434 | C |
---|
435 | C AUTHOR. |
---|
436 | C ------- |
---|
437 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
438 | C |
---|
439 | C MODIFICATIONS. |
---|
440 | C -------------- |
---|
441 | C ORIGINAL : 89-07-14 |
---|
442 | C 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo |
---|
443 | c 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER) |
---|
444 | C ------------------------------------------------------------------ |
---|
445 | C |
---|
446 | C* ARGUMENTS: |
---|
447 | C |
---|
448 | REAL*8 PSCT ! constante solaire (valeur conseillee: 1370) |
---|
449 | cIM ctes ds clesphys.h REAL*8 RCO2 ! concentration CO2 (IPCC: 353.E-06*44.011/28.97) |
---|
450 | #include "clesphys.h" |
---|
451 | C |
---|
452 | REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (PA) |
---|
453 | REAL*8 PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA) |
---|
454 | REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB) |
---|
455 | C |
---|
456 | REAL*8 PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE |
---|
457 | REAL*8 PFRAC(KDLON) ! fraction de la journee |
---|
458 | C |
---|
459 | REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K) |
---|
460 | REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (KG/KG) |
---|
461 | REAL*8 PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG) |
---|
462 | REAL*8 POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG) |
---|
463 | REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS |
---|
464 | C |
---|
465 | REAL*8 PALBD(KDLON,2) ! albedo du sol (lumiere diffuse) |
---|
466 | REAL*8 PALBP(KDLON,2) ! albedo du sol (lumiere parallele) |
---|
467 | C |
---|
468 | REAL*8 PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION |
---|
469 | REAL*8 PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS |
---|
470 | REAL*8 PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR |
---|
471 | REAL*8 POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO |
---|
472 | C |
---|
473 | REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY) |
---|
474 | REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky |
---|
475 | REAL*8 PALBPLA(KDLON) ! PLANETARY ALBEDO |
---|
476 | REAL*8 PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A. |
---|
477 | REAL*8 PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE |
---|
478 | REAL*8 PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY) |
---|
479 | REAL*8 PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY) |
---|
480 | C |
---|
481 | C* LOCAL VARIABLES: |
---|
482 | C |
---|
483 | REAL*8 ZOZ(KDLON,KFLEV) |
---|
484 | REAL*8 ZAKI(KDLON,2) |
---|
485 | REAL*8 ZCLD(KDLON,KFLEV) |
---|
486 | REAL*8 ZCLEAR(KDLON) |
---|
487 | REAL*8 ZDSIG(KDLON,KFLEV) |
---|
488 | REAL*8 ZFACT(KDLON) |
---|
489 | REAL*8 ZFD(KDLON,KFLEV+1) |
---|
490 | REAL*8 ZFDOWN(KDLON,KFLEV+1) |
---|
491 | REAL*8 ZFU(KDLON,KFLEV+1) |
---|
492 | REAL*8 ZFUP(KDLON,KFLEV+1) |
---|
493 | REAL*8 ZRMU(KDLON) |
---|
494 | REAL*8 ZSEC(KDLON) |
---|
495 | REAL*8 ZUD(KDLON,5,KFLEV+1) |
---|
496 | REAL*8 ZCLDSW0(KDLON,KFLEV) |
---|
497 | c |
---|
498 | REAL*8 ZFSUP(KDLON,KFLEV+1) |
---|
499 | REAL*8 ZFSDN(KDLON,KFLEV+1) |
---|
500 | REAL*8 ZFSUP0(KDLON,KFLEV+1) |
---|
501 | REAL*8 ZFSDN0(KDLON,KFLEV+1) |
---|
502 | C |
---|
503 | INTEGER inu, jl, jk, i, k, kpl1 |
---|
504 | c |
---|
505 | INTEGER swpas ! Every swpas steps, sw is calculated |
---|
506 | PARAMETER(swpas=1) |
---|
507 | c |
---|
508 | INTEGER itapsw |
---|
509 | LOGICAL appel1er |
---|
510 | DATA itapsw /0/ |
---|
511 | DATA appel1er /.TRUE./ |
---|
512 | SAVE itapsw,appel1er |
---|
513 | c$OMP THREADPRIVATE(appel1er) |
---|
514 | c$OMP THREADPRIVATE(itapsw) |
---|
515 | cjq-Introduced for aerosol forcings |
---|
516 | real*8 flag_aer |
---|
517 | logical ok_ade, ok_aie ! use aerosol forcings or not? |
---|
518 | real*8 tauae(kdlon,kflev,2) ! aerosol optical properties |
---|
519 | real*8 pizae(kdlon,kflev,2) ! (see aeropt.F) |
---|
520 | real*8 cgae(kdlon,kflev,2) ! -"- |
---|
521 | REAL*8 PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value) |
---|
522 | REAL*8 POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO |
---|
523 | REAL*8 PTOPSWAD(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR) |
---|
524 | REAL*8 PSOLSWAD(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR) |
---|
525 | REAL*8 PTOPSWAI(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND) |
---|
526 | REAL*8 PSOLSWAI(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND) |
---|
527 | cjq - Fluxes including aerosol effects |
---|
528 | REAL*8,allocatable,save :: ZFSUPAD(:,:) |
---|
529 | c$OMP THREADPRIVATE(ZFSUPAD) |
---|
530 | REAL*8,allocatable,save :: ZFSDNAD(:,:) |
---|
531 | c$OMP THREADPRIVATE(ZFSDNAD) |
---|
532 | REAL*8,allocatable,save :: ZFSUPAI(:,:) |
---|
533 | c$OMP THREADPRIVATE(ZFSUPAI) |
---|
534 | REAL*8,allocatable,save :: ZFSDNAI(:,:) |
---|
535 | c$OMP THREADPRIVATE(ZFSDNAI) |
---|
536 | logical initialized |
---|
537 | cym SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes |
---|
538 | !rv |
---|
539 | save flag_aer |
---|
540 | c$OMP THREADPRIVATE(flag_aer) |
---|
541 | data initialized/.false./ |
---|
542 | save initialized |
---|
543 | c$OMP THREADPRIVATE(initialized) |
---|
544 | cjq-end |
---|
545 | if(.not.initialized) then |
---|
546 | flag_aer=0. |
---|
547 | initialized=.TRUE. |
---|
548 | allocate(ZFSUPAD(KDLON,KFLEV+1)) |
---|
549 | allocate(ZFSDNAD(KDLON,KFLEV+1)) |
---|
550 | allocate(ZFSUPAI(KDLON,KFLEV+1)) |
---|
551 | allocate(ZFSDNAI(KDLON,KFLEV+1)) |
---|
552 | ZFSUPAD(:,:)=0. |
---|
553 | ZFSDNAD(:,:)=0. |
---|
554 | ZFSUPAI(:,:)=0. |
---|
555 | ZFSDNAI(:,:)=0. |
---|
556 | |
---|
557 | endif |
---|
558 | !rv |
---|
559 | |
---|
560 | c |
---|
561 | IF (appel1er) THEN |
---|
562 | PRINT*, 'SW calling frequency : ', swpas |
---|
563 | PRINT*, " In general, it should be 1" |
---|
564 | appel1er = .FALSE. |
---|
565 | ENDIF |
---|
566 | C ------------------------------------------------------------------ |
---|
567 | IF (MOD(itapsw,swpas).EQ.0) THEN |
---|
568 | c |
---|
569 | DO JK = 1 , KFLEV |
---|
570 | DO JL = 1, KDLON |
---|
571 | ZCLDSW0(JL,JK) = 0.0 |
---|
572 | ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG |
---|
573 | . *PDP(JL,JK)*(101325.0/PPSOL(JL)) |
---|
574 | ENDDO |
---|
575 | ENDDO |
---|
576 | C |
---|
577 | C |
---|
578 | c clear-sky: |
---|
579 | cIM ctes ds clesphys.h CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL, |
---|
580 | CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL, |
---|
581 | S PRMU0,PFRAC,PTAVE,PWV, |
---|
582 | S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
---|
583 | INU = 1 |
---|
584 | CALL SW1S(INU, |
---|
585 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
586 | S PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, |
---|
587 | S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
---|
588 | S ZFD, ZFU) |
---|
589 | INU = 2 |
---|
590 | CALL SW2S(INU, |
---|
591 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
592 | S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, |
---|
593 | S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
---|
594 | S PWV, PQS, |
---|
595 | S ZFDOWN, ZFUP) |
---|
596 | DO JK = 1 , KFLEV+1 |
---|
597 | DO JL = 1, KDLON |
---|
598 | ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
---|
599 | ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
---|
600 | ENDDO |
---|
601 | ENDDO |
---|
602 | |
---|
603 | flag_aer=0.0 |
---|
604 | CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, |
---|
605 | S PRMU0,PFRAC,PTAVE,PWV, |
---|
606 | S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
---|
607 | INU = 1 |
---|
608 | CALL SW1S(INU, |
---|
609 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
610 | S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
---|
611 | S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
---|
612 | S ZFD, ZFU) |
---|
613 | INU = 2 |
---|
614 | CALL SW2S(INU, |
---|
615 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
616 | S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
---|
617 | S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
---|
618 | S PWV, PQS, |
---|
619 | S ZFDOWN, ZFUP) |
---|
620 | |
---|
621 | c cloudy-sky: |
---|
622 | |
---|
623 | DO JK = 1 , KFLEV+1 |
---|
624 | DO JL = 1, KDLON |
---|
625 | ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
---|
626 | ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
---|
627 | ENDDO |
---|
628 | ENDDO |
---|
629 | |
---|
630 | c |
---|
631 | IF (ok_ade) THEN |
---|
632 | c |
---|
633 | c cloudy-sky + aerosol dir OB |
---|
634 | flag_aer=1.0 |
---|
635 | CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, |
---|
636 | S PRMU0,PFRAC,PTAVE,PWV, |
---|
637 | S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
---|
638 | INU = 1 |
---|
639 | CALL SW1S(INU, |
---|
640 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
641 | S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
---|
642 | S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
---|
643 | S ZFD, ZFU) |
---|
644 | INU = 2 |
---|
645 | CALL SW2S(INU, |
---|
646 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
647 | S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
---|
648 | S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, |
---|
649 | S PWV, PQS, |
---|
650 | S ZFDOWN, ZFUP) |
---|
651 | DO JK = 1 , KFLEV+1 |
---|
652 | DO JL = 1, KDLON |
---|
653 | ZFSUPAD(JL,JK) = ZFSUP(JL,JK) |
---|
654 | ZFSDNAD(JL,JK) = ZFSDN(JL,JK) |
---|
655 | ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
---|
656 | ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
---|
657 | ENDDO |
---|
658 | ENDDO |
---|
659 | |
---|
660 | ENDIF ! ok_ade |
---|
661 | |
---|
662 | IF (ok_aie) THEN |
---|
663 | |
---|
664 | cjq cloudy-sky + aerosol direct + aerosol indirect |
---|
665 | flag_aer=1.0 |
---|
666 | CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, |
---|
667 | S PRMU0,PFRAC,PTAVE,PWV, |
---|
668 | S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) |
---|
669 | INU = 1 |
---|
670 | CALL SW1S(INU, |
---|
671 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
672 | S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
---|
673 | S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, |
---|
674 | S ZFD, ZFU) |
---|
675 | INU = 2 |
---|
676 | CALL SW2S(INU, |
---|
677 | S PAER, flag_aer, tauae, pizae, cgae, |
---|
678 | S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, |
---|
679 | S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, |
---|
680 | S PWV, PQS, |
---|
681 | S ZFDOWN, ZFUP) |
---|
682 | DO JK = 1 , KFLEV+1 |
---|
683 | DO JL = 1, KDLON |
---|
684 | ZFSUPAI(JL,JK) = ZFSUP(JL,JK) |
---|
685 | ZFSDNAI(JL,JK) = ZFSDN(JL,JK) |
---|
686 | ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) |
---|
687 | ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) |
---|
688 | ENDDO |
---|
689 | ENDDO |
---|
690 | ENDIF ! ok_aie |
---|
691 | cjq -end |
---|
692 | |
---|
693 | itapsw = 0 |
---|
694 | ENDIF |
---|
695 | itapsw = itapsw + 1 |
---|
696 | C |
---|
697 | DO k = 1, KFLEV |
---|
698 | kpl1 = k+1 |
---|
699 | DO i = 1, KDLON |
---|
700 | PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) |
---|
701 | . -(ZFSDN(i,k)-ZFSDN(i,kpl1)) |
---|
702 | PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k) |
---|
703 | PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k)) |
---|
704 | . -(ZFSDN0(i,k)-ZFSDN0(i,kpl1)) |
---|
705 | PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k) |
---|
706 | ENDDO |
---|
707 | ENDDO |
---|
708 | DO i = 1, KDLON |
---|
709 | PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20) |
---|
710 | c |
---|
711 | PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1) |
---|
712 | PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1) |
---|
713 | c |
---|
714 | PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1) |
---|
715 | PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1) |
---|
716 | c-OB |
---|
717 | PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1) |
---|
718 | PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1) |
---|
719 | c |
---|
720 | PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1) |
---|
721 | PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1) |
---|
722 | c-fin |
---|
723 | ENDDO |
---|
724 | C |
---|
725 | RETURN |
---|
726 | END |
---|
727 | c |
---|
728 | cIM ctes ds clesphys.h SUBROUTINE SWU (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC, |
---|
729 | SUBROUTINE SWU (PSCT,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC, |
---|
730 | S PTAVE,PWV,PAKI,PCLD,PCLEAR,PDSIG,PFACT, |
---|
731 | S PRMU,PSEC,PUD) |
---|
732 | USE dimphy |
---|
733 | IMPLICIT none |
---|
734 | cym#include "dimensions.h" |
---|
735 | cym#include "dimphy.h" |
---|
736 | cym#include "raddim.h" |
---|
737 | #include "radepsi.h" |
---|
738 | #include "radopt.h" |
---|
739 | #include "YOMCST.h" |
---|
740 | C |
---|
741 | C* ARGUMENTS: |
---|
742 | C |
---|
743 | REAL*8 PSCT |
---|
744 | cIM ctes ds clesphys.h REAL*8 RCO2 |
---|
745 | #include "clesphys.h" |
---|
746 | REAL*8 PCLDSW(KDLON,KFLEV) |
---|
747 | REAL*8 PPMB(KDLON,KFLEV+1) |
---|
748 | REAL*8 PPSOL(KDLON) |
---|
749 | REAL*8 PRMU0(KDLON) |
---|
750 | REAL*8 PFRAC(KDLON) |
---|
751 | REAL*8 PTAVE(KDLON,KFLEV) |
---|
752 | REAL*8 PWV(KDLON,KFLEV) |
---|
753 | C |
---|
754 | REAL*8 PAKI(KDLON,2) |
---|
755 | REAL*8 PCLD(KDLON,KFLEV) |
---|
756 | REAL*8 PCLEAR(KDLON) |
---|
757 | REAL*8 PDSIG(KDLON,KFLEV) |
---|
758 | REAL*8 PFACT(KDLON) |
---|
759 | REAL*8 PRMU(KDLON) |
---|
760 | REAL*8 PSEC(KDLON) |
---|
761 | REAL*8 PUD(KDLON,5,KFLEV+1) |
---|
762 | C |
---|
763 | C* LOCAL VARIABLES: |
---|
764 | C |
---|
765 | INTEGER IIND(2) |
---|
766 | REAL*8 ZC1J(KDLON,KFLEV+1) |
---|
767 | REAL*8 ZCLEAR(KDLON) |
---|
768 | REAL*8 ZCLOUD(KDLON) |
---|
769 | REAL*8 ZN175(KDLON) |
---|
770 | REAL*8 ZN190(KDLON) |
---|
771 | REAL*8 ZO175(KDLON) |
---|
772 | REAL*8 ZO190(KDLON) |
---|
773 | REAL*8 ZSIGN(KDLON) |
---|
774 | REAL*8 ZR(KDLON,2) |
---|
775 | REAL*8 ZSIGO(KDLON) |
---|
776 | REAL*8 ZUD(KDLON,2) |
---|
777 | REAL*8 ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW |
---|
778 | INTEGER jl, jk, jkp1, jkl, jklp1, ja |
---|
779 | C |
---|
780 | C* Prescribed Data: |
---|
781 | c |
---|
782 | REAL*8 ZPDH2O,ZPDUMG |
---|
783 | SAVE ZPDH2O,ZPDUMG |
---|
784 | c$OMP THREADPRIVATE(ZPDH2O,ZPDUMG) |
---|
785 | REAL*8 ZPRH2O,ZPRUMG |
---|
786 | SAVE ZPRH2O,ZPRUMG |
---|
787 | c$OMP THREADPRIVATE(ZPRH2O,ZPRUMG) |
---|
788 | REAL*8 RTDH2O,RTDUMG |
---|
789 | SAVE RTDH2O,RTDUMG |
---|
790 | c$OMP THREADPRIVATE(RTDH2O,RTDUMG) |
---|
791 | REAL*8 RTH2O ,RTUMG |
---|
792 | SAVE RTH2O ,RTUMG |
---|
793 | c$OMP THREADPRIVATE(RTH2O ,RTUMG) |
---|
794 | DATA ZPDH2O,ZPDUMG / 0.8 , 0.75 / |
---|
795 | DATA ZPRH2O,ZPRUMG / 30000., 30000. / |
---|
796 | DATA RTDH2O,RTDUMG / 0.40 , 0.375 / |
---|
797 | DATA RTH2O ,RTUMG / 240. , 240. / |
---|
798 | C ------------------------------------------------------------------ |
---|
799 | C |
---|
800 | C* 1. COMPUTES AMOUNTS OF ABSORBERS |
---|
801 | C ----------------------------- |
---|
802 | C |
---|
803 | 100 CONTINUE |
---|
804 | C |
---|
805 | IIND(1)=1 |
---|
806 | IIND(2)=2 |
---|
807 | C |
---|
808 | C |
---|
809 | C* 1.1 INITIALIZES QUANTITIES |
---|
810 | C ---------------------- |
---|
811 | C |
---|
812 | 110 CONTINUE |
---|
813 | C |
---|
814 | DO 111 JL = 1, KDLON |
---|
815 | PUD(JL,1,KFLEV+1)=0. |
---|
816 | PUD(JL,2,KFLEV+1)=0. |
---|
817 | PUD(JL,3,KFLEV+1)=0. |
---|
818 | PUD(JL,4,KFLEV+1)=0. |
---|
819 | PUD(JL,5,KFLEV+1)=0. |
---|
820 | PFACT(JL)= PRMU0(JL) * PFRAC(JL) * PSCT |
---|
821 | PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. |
---|
822 | PSEC(JL)=1./PRMU(JL) |
---|
823 | ZC1J(JL,KFLEV+1)=0. |
---|
824 | 111 CONTINUE |
---|
825 | C |
---|
826 | C* 1.3 AMOUNTS OF ABSORBERS |
---|
827 | C -------------------- |
---|
828 | C |
---|
829 | 130 CONTINUE |
---|
830 | C |
---|
831 | DO 131 JL= 1, KDLON |
---|
832 | ZUD(JL,1) = 0. |
---|
833 | ZUD(JL,2) = 0. |
---|
834 | ZO175(JL) = PPSOL(JL)** (ZPDUMG+1.) |
---|
835 | ZO190(JL) = PPSOL(JL)** (ZPDH2O+1.) |
---|
836 | ZSIGO(JL) = PPSOL(JL) |
---|
837 | ZCLEAR(JL)=1. |
---|
838 | ZCLOUD(JL)=0. |
---|
839 | 131 CONTINUE |
---|
840 | C |
---|
841 | DO 133 JK = 1 , KFLEV |
---|
842 | JKP1 = JK + 1 |
---|
843 | JKL = KFLEV+1 - JK |
---|
844 | JKLP1 = JKL+1 |
---|
845 | DO 132 JL = 1, KDLON |
---|
846 | ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O |
---|
847 | ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG |
---|
848 | ZWH2O = MAX (PWV(JL,JK) , ZEPSCQ ) |
---|
849 | ZSIGN(JL) = 100. * PPMB(JL,JKP1) |
---|
850 | PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL) |
---|
851 | ZN175(JL) = ZSIGN(JL) ** (ZPDUMG+1.) |
---|
852 | ZN190(JL) = ZSIGN(JL) ** (ZPDH2O+1.) |
---|
853 | ZDSCO2 = ZO175(JL) - ZN175(JL) |
---|
854 | ZDSH2O = ZO190(JL) - ZN190(JL) |
---|
855 | PUD(JL,1,JK) = 1./( 10.* RG * (ZPDH2O+1.) )/(ZPRH2O**ZPDH2O) |
---|
856 | . * ZDSH2O * ZWH2O * ZRTH |
---|
857 | PUD(JL,2,JK) = 1./( 10.* RG * (ZPDUMG+1.) )/(ZPRUMG**ZPDUMG) |
---|
858 | . * ZDSCO2 * RCO2 * ZRTU |
---|
859 | ZFPPW=1.6078*ZWH2O/(1.+0.608*ZWH2O) |
---|
860 | PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW |
---|
861 | PUD(JL,5,JK)=PUD(JL,1,JK)*(1.-ZFPPW) |
---|
862 | ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK) |
---|
863 | ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK) |
---|
864 | ZSIGO(JL) = ZSIGN(JL) |
---|
865 | ZO175(JL) = ZN175(JL) |
---|
866 | ZO190(JL) = ZN190(JL) |
---|
867 | C |
---|
868 | IF (NOVLP.EQ.1) THEN |
---|
869 | ZCLEAR(JL)=ZCLEAR(JL) |
---|
870 | S *(1.-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) |
---|
871 | S /(1.-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
---|
872 | ZC1J(JL,JKL)= 1.0 - ZCLEAR(JL) |
---|
873 | ZCLOUD(JL) = PCLDSW(JL,JKL) |
---|
874 | ELSE IF (NOVLP.EQ.2) THEN |
---|
875 | ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL)) |
---|
876 | ZC1J(JL,JKL) = ZCLOUD(JL) |
---|
877 | ELSE IF (NOVLP.EQ.3) THEN |
---|
878 | ZCLEAR(JL) = ZCLEAR(JL)*(1.-PCLDSW(JL,JKL)) |
---|
879 | ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
---|
880 | ZC1J(JL,JKL) = ZCLOUD(JL) |
---|
881 | END IF |
---|
882 | 132 CONTINUE |
---|
883 | 133 CONTINUE |
---|
884 | DO 134 JL=1, KDLON |
---|
885 | PCLEAR(JL)=1.-ZC1J(JL,1) |
---|
886 | 134 CONTINUE |
---|
887 | DO 136 JK=1,KFLEV |
---|
888 | DO 135 JL=1, KDLON |
---|
889 | IF (PCLEAR(JL).LT.1.) THEN |
---|
890 | PCLD(JL,JK)=PCLDSW(JL,JK)/(1.-PCLEAR(JL)) |
---|
891 | ELSE |
---|
892 | PCLD(JL,JK)=0. |
---|
893 | END IF |
---|
894 | 135 CONTINUE |
---|
895 | 136 CONTINUE |
---|
896 | C |
---|
897 | C |
---|
898 | C* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS |
---|
899 | C ----------------------------------------------- |
---|
900 | C |
---|
901 | 140 CONTINUE |
---|
902 | C |
---|
903 | DO 142 JA = 1,2 |
---|
904 | DO 141 JL = 1, KDLON |
---|
905 | ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL) |
---|
906 | 141 CONTINUE |
---|
907 | 142 CONTINUE |
---|
908 | C |
---|
909 | CALL SWTT1(2, 2, IIND, ZUD, ZR) |
---|
910 | C |
---|
911 | DO 144 JA = 1,2 |
---|
912 | DO 143 JL = 1, KDLON |
---|
913 | PAKI(JL,JA) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA) |
---|
914 | 143 CONTINUE |
---|
915 | 144 CONTINUE |
---|
916 | C |
---|
917 | C |
---|
918 | C ------------------------------------------------------------------ |
---|
919 | C |
---|
920 | RETURN |
---|
921 | END |
---|
922 | SUBROUTINE SW1S ( KNU |
---|
923 | S , PAER , flag_aer, tauae, pizae, cgae |
---|
924 | S , PALBD , PALBP, PCG , PCLD , PCLEAR, PCLDSW |
---|
925 | S , PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD |
---|
926 | S , PFD , PFU) |
---|
927 | USE dimphy |
---|
928 | IMPLICIT none |
---|
929 | cym#include "dimensions.h" |
---|
930 | cym#include "dimphy.h" |
---|
931 | cym#include "raddim.h" |
---|
932 | C |
---|
933 | C ------------------------------------------------------------------ |
---|
934 | C PURPOSE. |
---|
935 | C -------- |
---|
936 | C |
---|
937 | C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO |
---|
938 | C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). |
---|
939 | C |
---|
940 | C METHOD. |
---|
941 | C ------- |
---|
942 | C |
---|
943 | C 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO |
---|
944 | C CONTINUUM SCATTERING |
---|
945 | C 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION |
---|
946 | C |
---|
947 | C REFERENCE. |
---|
948 | C ---------- |
---|
949 | C |
---|
950 | C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
---|
951 | C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
---|
952 | C |
---|
953 | C AUTHOR. |
---|
954 | C ------- |
---|
955 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
956 | C |
---|
957 | C MODIFICATIONS. |
---|
958 | C -------------- |
---|
959 | C ORIGINAL : 89-07-14 |
---|
960 | C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO |
---|
961 | C ------------------------------------------------------------------ |
---|
962 | C |
---|
963 | C* ARGUMENTS: |
---|
964 | C |
---|
965 | INTEGER KNU |
---|
966 | c-OB |
---|
967 | real*8 flag_aer |
---|
968 | real*8 tauae(kdlon,kflev,2) |
---|
969 | real*8 pizae(kdlon,kflev,2) |
---|
970 | real*8 cgae(kdlon,kflev,2) |
---|
971 | REAL*8 PAER(KDLON,KFLEV,5) |
---|
972 | REAL*8 PALBD(KDLON,2) |
---|
973 | REAL*8 PALBP(KDLON,2) |
---|
974 | REAL*8 PCG(KDLON,2,KFLEV) |
---|
975 | REAL*8 PCLD(KDLON,KFLEV) |
---|
976 | REAL*8 PCLDSW(KDLON,KFLEV) |
---|
977 | REAL*8 PCLEAR(KDLON) |
---|
978 | REAL*8 PDSIG(KDLON,KFLEV) |
---|
979 | REAL*8 POMEGA(KDLON,2,KFLEV) |
---|
980 | REAL*8 POZ(KDLON,KFLEV) |
---|
981 | REAL*8 PRMU(KDLON) |
---|
982 | REAL*8 PSEC(KDLON) |
---|
983 | REAL*8 PTAU(KDLON,2,KFLEV) |
---|
984 | REAL*8 PUD(KDLON,5,KFLEV+1) |
---|
985 | C |
---|
986 | REAL*8 PFD(KDLON,KFLEV+1) |
---|
987 | REAL*8 PFU(KDLON,KFLEV+1) |
---|
988 | C |
---|
989 | C* LOCAL VARIABLES: |
---|
990 | C |
---|
991 | INTEGER IIND(4) |
---|
992 | C |
---|
993 | REAL*8 ZCGAZ(KDLON,KFLEV) |
---|
994 | REAL*8 ZDIFF(KDLON) |
---|
995 | REAL*8 ZDIRF(KDLON) |
---|
996 | REAL*8 ZPIZAZ(KDLON,KFLEV) |
---|
997 | REAL*8 ZRAYL(KDLON) |
---|
998 | REAL*8 ZRAY1(KDLON,KFLEV+1) |
---|
999 | REAL*8 ZRAY2(KDLON,KFLEV+1) |
---|
1000 | REAL*8 ZREFZ(KDLON,2,KFLEV+1) |
---|
1001 | REAL*8 ZRJ(KDLON,6,KFLEV+1) |
---|
1002 | REAL*8 ZRJ0(KDLON,6,KFLEV+1) |
---|
1003 | REAL*8 ZRK(KDLON,6,KFLEV+1) |
---|
1004 | REAL*8 ZRK0(KDLON,6,KFLEV+1) |
---|
1005 | REAL*8 ZRMUE(KDLON,KFLEV+1) |
---|
1006 | REAL*8 ZRMU0(KDLON,KFLEV+1) |
---|
1007 | REAL*8 ZR(KDLON,4) |
---|
1008 | REAL*8 ZTAUAZ(KDLON,KFLEV) |
---|
1009 | REAL*8 ZTRA1(KDLON,KFLEV+1) |
---|
1010 | REAL*8 ZTRA2(KDLON,KFLEV+1) |
---|
1011 | REAL*8 ZW(KDLON,4) |
---|
1012 | C |
---|
1013 | INTEGER jl, jk, k, jaj, ikm1, ikl |
---|
1014 | c |
---|
1015 | c Prescribed Data: |
---|
1016 | c |
---|
1017 | REAL*8 RSUN(2) |
---|
1018 | SAVE RSUN |
---|
1019 | c$OMP THREADPRIVATE(RSUN) |
---|
1020 | REAL*8 RRAY(2,6) |
---|
1021 | SAVE RRAY |
---|
1022 | c$OMP THREADPRIVATE(RRAY) |
---|
1023 | DATA RSUN(1) / 0.441676 / |
---|
1024 | DATA RSUN(2) / 0.558324 / |
---|
1025 | DATA (RRAY(1,K),K=1,6) / |
---|
1026 | S .428937E-01, .890743E+00,-.288555E+01, |
---|
1027 | S .522744E+01,-.469173E+01, .161645E+01/ |
---|
1028 | DATA (RRAY(2,K),K=1,6) / |
---|
1029 | S .697200E-02, .173297E-01,-.850903E-01, |
---|
1030 | S .248261E+00,-.302031E+00, .129662E+00/ |
---|
1031 | C ------------------------------------------------------------------ |
---|
1032 | C |
---|
1033 | C* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON) |
---|
1034 | C ----------------------- ------------------ |
---|
1035 | C |
---|
1036 | 100 CONTINUE |
---|
1037 | C |
---|
1038 | C |
---|
1039 | C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING |
---|
1040 | C ----------------------------------------- |
---|
1041 | C |
---|
1042 | 110 CONTINUE |
---|
1043 | C |
---|
1044 | DO 111 JL = 1, KDLON |
---|
1045 | ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL) |
---|
1046 | S * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL) |
---|
1047 | S * (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) )))) |
---|
1048 | 111 CONTINUE |
---|
1049 | C |
---|
1050 | C |
---|
1051 | C ------------------------------------------------------------------ |
---|
1052 | C |
---|
1053 | C* 2. CONTINUUM SCATTERING CALCULATIONS |
---|
1054 | C --------------------------------- |
---|
1055 | C |
---|
1056 | 200 CONTINUE |
---|
1057 | C |
---|
1058 | C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN |
---|
1059 | C -------------------------------- |
---|
1060 | C |
---|
1061 | 210 CONTINUE |
---|
1062 | C |
---|
1063 | CALL SWCLR ( KNU |
---|
1064 | S , PAER , flag_aer, tauae, pizae, cgae |
---|
1065 | S , PALBP , PDSIG , ZRAYL, PSEC |
---|
1066 | S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 |
---|
1067 | S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2) |
---|
1068 | C |
---|
1069 | C |
---|
1070 | C* 2.2 CLOUDY FRACTION OF THE COLUMN |
---|
1071 | C ----------------------------- |
---|
1072 | C |
---|
1073 | 220 CONTINUE |
---|
1074 | C |
---|
1075 | CALL SWR ( KNU |
---|
1076 | S , PALBD ,PCG ,PCLD ,PDSIG ,POMEGA,ZRAYL |
---|
1077 | S , PSEC ,PTAU |
---|
1078 | S , ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 ,ZREFZ ,ZRJ ,ZRK,ZRMUE |
---|
1079 | S , ZTAUAZ,ZTRA1 ,ZTRA2) |
---|
1080 | C |
---|
1081 | C |
---|
1082 | C ------------------------------------------------------------------ |
---|
1083 | C |
---|
1084 | C* 3. OZONE ABSORPTION |
---|
1085 | C ---------------- |
---|
1086 | C |
---|
1087 | 300 CONTINUE |
---|
1088 | C |
---|
1089 | IIND(1)=1 |
---|
1090 | IIND(2)=3 |
---|
1091 | IIND(3)=1 |
---|
1092 | IIND(4)=3 |
---|
1093 | C |
---|
1094 | C |
---|
1095 | C* 3.1 DOWNWARD FLUXES |
---|
1096 | C --------------- |
---|
1097 | C |
---|
1098 | 310 CONTINUE |
---|
1099 | C |
---|
1100 | JAJ = 2 |
---|
1101 | C |
---|
1102 | DO 311 JL = 1, KDLON |
---|
1103 | ZW(JL,1)=0. |
---|
1104 | ZW(JL,2)=0. |
---|
1105 | ZW(JL,3)=0. |
---|
1106 | ZW(JL,4)=0. |
---|
1107 | PFD(JL,KFLEV+1)=((1.-PCLEAR(JL))*ZRJ(JL,JAJ,KFLEV+1) |
---|
1108 | S + PCLEAR(JL) *ZRJ0(JL,JAJ,KFLEV+1)) * RSUN(KNU) |
---|
1109 | 311 CONTINUE |
---|
1110 | DO 314 JK = 1 , KFLEV |
---|
1111 | IKL = KFLEV+1-JK |
---|
1112 | DO 312 JL = 1, KDLON |
---|
1113 | ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL) |
---|
1114 | ZW(JL,2)=ZW(JL,2)+POZ(JL, IKL)/ZRMUE(JL,IKL) |
---|
1115 | ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) |
---|
1116 | ZW(JL,4)=ZW(JL,4)+POZ(JL, IKL)/ZRMU0(JL,IKL) |
---|
1117 | 312 CONTINUE |
---|
1118 | C |
---|
1119 | CALL SWTT1(KNU, 4, IIND, ZW, ZR) |
---|
1120 | C |
---|
1121 | DO 313 JL = 1, KDLON |
---|
1122 | ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRJ(JL,JAJ,IKL) |
---|
1123 | ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRJ0(JL,JAJ,IKL) |
---|
1124 | PFD(JL,IKL) = ((1.-PCLEAR(JL)) * ZDIFF(JL) |
---|
1125 | S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
---|
1126 | 313 CONTINUE |
---|
1127 | 314 CONTINUE |
---|
1128 | C |
---|
1129 | C |
---|
1130 | C* 3.2 UPWARD FLUXES |
---|
1131 | C ------------- |
---|
1132 | C |
---|
1133 | 320 CONTINUE |
---|
1134 | C |
---|
1135 | DO 325 JL = 1, KDLON |
---|
1136 | PFU(JL,1) = ((1.-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU) |
---|
1137 | S + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU)) |
---|
1138 | S * RSUN(KNU) |
---|
1139 | 325 CONTINUE |
---|
1140 | C |
---|
1141 | DO 328 JK = 2 , KFLEV+1 |
---|
1142 | IKM1=JK-1 |
---|
1143 | DO 326 JL = 1, KDLON |
---|
1144 | ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66 |
---|
1145 | ZW(JL,2)=ZW(JL,2)+POZ(JL, IKM1)*1.66 |
---|
1146 | ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66 |
---|
1147 | ZW(JL,4)=ZW(JL,4)+POZ(JL, IKM1)*1.66 |
---|
1148 | 326 CONTINUE |
---|
1149 | C |
---|
1150 | CALL SWTT1(KNU, 4, IIND, ZW, ZR) |
---|
1151 | C |
---|
1152 | DO 327 JL = 1, KDLON |
---|
1153 | ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRK(JL,JAJ,JK) |
---|
1154 | ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRK0(JL,JAJ,JK) |
---|
1155 | PFU(JL,JK) = ((1.-PCLEAR(JL)) * ZDIFF(JL) |
---|
1156 | S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) |
---|
1157 | 327 CONTINUE |
---|
1158 | 328 CONTINUE |
---|
1159 | C |
---|
1160 | C ------------------------------------------------------------------ |
---|
1161 | C |
---|
1162 | RETURN |
---|
1163 | END |
---|
1164 | SUBROUTINE SW2S ( KNU |
---|
1165 | S , PAER , flag_aer, tauae, pizae, cgae |
---|
1166 | S , PAKI, PALBD, PALBP, PCG , PCLD, PCLEAR, PCLDSW |
---|
1167 | S , PDSIG ,POMEGA,POZ , PRMU , PSEC , PTAU |
---|
1168 | S , PUD ,PWV , PQS |
---|
1169 | S , PFDOWN,PFUP ) |
---|
1170 | USE dimphy |
---|
1171 | IMPLICIT none |
---|
1172 | cym#include "dimensions.h" |
---|
1173 | cym#include "dimphy.h" |
---|
1174 | cym#include "raddim.h" |
---|
1175 | #include "radepsi.h" |
---|
1176 | C |
---|
1177 | C ------------------------------------------------------------------ |
---|
1178 | C PURPOSE. |
---|
1179 | C -------- |
---|
1180 | C |
---|
1181 | C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE |
---|
1182 | C SECOND SPECTRAL INTERVAL FOLLOWING FOUQUART AND BONNEL (1980). |
---|
1183 | C |
---|
1184 | C METHOD. |
---|
1185 | C ------- |
---|
1186 | C |
---|
1187 | C 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO |
---|
1188 | C CONTINUUM SCATTERING |
---|
1189 | C 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR |
---|
1190 | C A GREY MOLECULAR ABSORPTION |
---|
1191 | C 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS |
---|
1192 | C OF ABSORBERS |
---|
1193 | C 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS |
---|
1194 | C 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION |
---|
1195 | C |
---|
1196 | C REFERENCE. |
---|
1197 | C ---------- |
---|
1198 | C |
---|
1199 | C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
---|
1200 | C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
---|
1201 | C |
---|
1202 | C AUTHOR. |
---|
1203 | C ------- |
---|
1204 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
1205 | C |
---|
1206 | C MODIFICATIONS. |
---|
1207 | C -------------- |
---|
1208 | C ORIGINAL : 89-07-14 |
---|
1209 | C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO |
---|
1210 | C ------------------------------------------------------------------ |
---|
1211 | C* ARGUMENTS: |
---|
1212 | C |
---|
1213 | INTEGER KNU |
---|
1214 | c-OB |
---|
1215 | real*8 flag_aer |
---|
1216 | real*8 tauae(kdlon,kflev,2) |
---|
1217 | real*8 pizae(kdlon,kflev,2) |
---|
1218 | real*8 cgae(kdlon,kflev,2) |
---|
1219 | REAL*8 PAER(KDLON,KFLEV,5) |
---|
1220 | REAL*8 PAKI(KDLON,2) |
---|
1221 | REAL*8 PALBD(KDLON,2) |
---|
1222 | REAL*8 PALBP(KDLON,2) |
---|
1223 | REAL*8 PCG(KDLON,2,KFLEV) |
---|
1224 | REAL*8 PCLD(KDLON,KFLEV) |
---|
1225 | REAL*8 PCLDSW(KDLON,KFLEV) |
---|
1226 | REAL*8 PCLEAR(KDLON) |
---|
1227 | REAL*8 PDSIG(KDLON,KFLEV) |
---|
1228 | REAL*8 POMEGA(KDLON,2,KFLEV) |
---|
1229 | REAL*8 POZ(KDLON,KFLEV) |
---|
1230 | REAL*8 PQS(KDLON,KFLEV) |
---|
1231 | REAL*8 PRMU(KDLON) |
---|
1232 | REAL*8 PSEC(KDLON) |
---|
1233 | REAL*8 PTAU(KDLON,2,KFLEV) |
---|
1234 | REAL*8 PUD(KDLON,5,KFLEV+1) |
---|
1235 | REAL*8 PWV(KDLON,KFLEV) |
---|
1236 | C |
---|
1237 | REAL*8 PFDOWN(KDLON,KFLEV+1) |
---|
1238 | REAL*8 PFUP(KDLON,KFLEV+1) |
---|
1239 | C |
---|
1240 | C* LOCAL VARIABLES: |
---|
1241 | C |
---|
1242 | INTEGER IIND2(2), IIND3(3) |
---|
1243 | REAL*8 ZCGAZ(KDLON,KFLEV) |
---|
1244 | REAL*8 ZFD(KDLON,KFLEV+1) |
---|
1245 | REAL*8 ZFU(KDLON,KFLEV+1) |
---|
1246 | REAL*8 ZG(KDLON) |
---|
1247 | REAL*8 ZGG(KDLON) |
---|
1248 | REAL*8 ZPIZAZ(KDLON,KFLEV) |
---|
1249 | REAL*8 ZRAYL(KDLON) |
---|
1250 | REAL*8 ZRAY1(KDLON,KFLEV+1) |
---|
1251 | REAL*8 ZRAY2(KDLON,KFLEV+1) |
---|
1252 | REAL*8 ZREF(KDLON) |
---|
1253 | REAL*8 ZREFZ(KDLON,2,KFLEV+1) |
---|
1254 | REAL*8 ZRE1(KDLON) |
---|
1255 | REAL*8 ZRE2(KDLON) |
---|
1256 | REAL*8 ZRJ(KDLON,6,KFLEV+1) |
---|
1257 | REAL*8 ZRJ0(KDLON,6,KFLEV+1) |
---|
1258 | REAL*8 ZRK(KDLON,6,KFLEV+1) |
---|
1259 | REAL*8 ZRK0(KDLON,6,KFLEV+1) |
---|
1260 | REAL*8 ZRL(KDLON,8) |
---|
1261 | REAL*8 ZRMUE(KDLON,KFLEV+1) |
---|
1262 | REAL*8 ZRMU0(KDLON,KFLEV+1) |
---|
1263 | REAL*8 ZRMUZ(KDLON) |
---|
1264 | REAL*8 ZRNEB(KDLON) |
---|
1265 | REAL*8 ZRUEF(KDLON,8) |
---|
1266 | REAL*8 ZR1(KDLON) |
---|
1267 | REAL*8 ZR2(KDLON,2) |
---|
1268 | REAL*8 ZR3(KDLON,3) |
---|
1269 | REAL*8 ZR4(KDLON) |
---|
1270 | REAL*8 ZR21(KDLON) |
---|
1271 | REAL*8 ZR22(KDLON) |
---|
1272 | REAL*8 ZS(KDLON) |
---|
1273 | REAL*8 ZTAUAZ(KDLON,KFLEV) |
---|
1274 | REAL*8 ZTO1(KDLON) |
---|
1275 | REAL*8 ZTR(KDLON,2,KFLEV+1) |
---|
1276 | REAL*8 ZTRA1(KDLON,KFLEV+1) |
---|
1277 | REAL*8 ZTRA2(KDLON,KFLEV+1) |
---|
1278 | REAL*8 ZTR1(KDLON) |
---|
1279 | REAL*8 ZTR2(KDLON) |
---|
1280 | REAL*8 ZW(KDLON) |
---|
1281 | REAL*8 ZW1(KDLON) |
---|
1282 | REAL*8 ZW2(KDLON,2) |
---|
1283 | REAL*8 ZW3(KDLON,3) |
---|
1284 | REAL*8 ZW4(KDLON) |
---|
1285 | REAL*8 ZW5(KDLON) |
---|
1286 | C |
---|
1287 | INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1 |
---|
1288 | INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs |
---|
1289 | REAL*8 ZRMUM1, ZWH2O, ZCNEB, ZAA, ZBB, ZRKI, ZRE11 |
---|
1290 | C |
---|
1291 | C* Prescribed Data: |
---|
1292 | C |
---|
1293 | REAL*8 RSUN(2) |
---|
1294 | SAVE RSUN |
---|
1295 | c$OMP THREADPRIVATE(RSUN) |
---|
1296 | REAL*8 RRAY(2,6) |
---|
1297 | SAVE RRAY |
---|
1298 | c$OMP THREADPRIVATE(RRAY) |
---|
1299 | DATA RSUN(1) / 0.441676 / |
---|
1300 | DATA RSUN(2) / 0.558324 / |
---|
1301 | DATA (RRAY(1,K),K=1,6) / |
---|
1302 | S .428937E-01, .890743E+00,-.288555E+01, |
---|
1303 | S .522744E+01,-.469173E+01, .161645E+01/ |
---|
1304 | DATA (RRAY(2,K),K=1,6) / |
---|
1305 | S .697200E-02, .173297E-01,-.850903E-01, |
---|
1306 | S .248261E+00,-.302031E+00, .129662E+00/ |
---|
1307 | C |
---|
1308 | C ------------------------------------------------------------------ |
---|
1309 | C |
---|
1310 | C* 1. SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON) |
---|
1311 | C ------------------------------------------- |
---|
1312 | C |
---|
1313 | 100 CONTINUE |
---|
1314 | C |
---|
1315 | C |
---|
1316 | C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING |
---|
1317 | C ----------------------------------------- |
---|
1318 | C |
---|
1319 | 110 CONTINUE |
---|
1320 | C |
---|
1321 | DO 111 JL = 1, KDLON |
---|
1322 | ZRMUM1 = 1. - PRMU(JL) |
---|
1323 | ZRAYL(JL) = RRAY(KNU,1) + ZRMUM1 * (RRAY(KNU,2) + ZRMUM1 |
---|
1324 | S * (RRAY(KNU,3) + ZRMUM1 * (RRAY(KNU,4) + ZRMUM1 |
---|
1325 | S * (RRAY(KNU,5) + ZRMUM1 * RRAY(KNU,6) )))) |
---|
1326 | 111 CONTINUE |
---|
1327 | C |
---|
1328 | C |
---|
1329 | C ------------------------------------------------------------------ |
---|
1330 | C |
---|
1331 | C* 2. CONTINUUM SCATTERING CALCULATIONS |
---|
1332 | C --------------------------------- |
---|
1333 | C |
---|
1334 | 200 CONTINUE |
---|
1335 | C |
---|
1336 | C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN |
---|
1337 | C -------------------------------- |
---|
1338 | C |
---|
1339 | 210 CONTINUE |
---|
1340 | C |
---|
1341 | CALL SWCLR ( KNU |
---|
1342 | S , PAER , flag_aer, tauae, pizae, cgae |
---|
1343 | S , PALBP , PDSIG , ZRAYL, PSEC |
---|
1344 | S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 |
---|
1345 | S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2) |
---|
1346 | C |
---|
1347 | C |
---|
1348 | C* 2.2 CLOUDY FRACTION OF THE COLUMN |
---|
1349 | C ----------------------------- |
---|
1350 | C |
---|
1351 | 220 CONTINUE |
---|
1352 | C |
---|
1353 | CALL SWR ( KNU |
---|
1354 | S , PALBD , PCG , PCLD , PDSIG, POMEGA, ZRAYL |
---|
1355 | S , PSEC , PTAU |
---|
1356 | S , ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2, ZREFZ , ZRJ , ZRK, ZRMUE |
---|
1357 | S , ZTAUAZ, ZTRA1 , ZTRA2) |
---|
1358 | C |
---|
1359 | C |
---|
1360 | C ------------------------------------------------------------------ |
---|
1361 | C |
---|
1362 | C* 3. SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION |
---|
1363 | C ------------------------------------------------------ |
---|
1364 | C |
---|
1365 | 300 CONTINUE |
---|
1366 | C |
---|
1367 | JN = 2 |
---|
1368 | C |
---|
1369 | DO 361 JABS=1,2 |
---|
1370 | C |
---|
1371 | C |
---|
1372 | C* 3.1 SURFACE CONDITIONS |
---|
1373 | C ------------------ |
---|
1374 | C |
---|
1375 | 310 CONTINUE |
---|
1376 | C |
---|
1377 | DO 311 JL = 1, KDLON |
---|
1378 | ZREFZ(JL,2,1) = PALBD(JL,KNU) |
---|
1379 | ZREFZ(JL,1,1) = PALBD(JL,KNU) |
---|
1380 | 311 CONTINUE |
---|
1381 | C |
---|
1382 | C |
---|
1383 | C* 3.2 INTRODUCING CLOUD EFFECTS |
---|
1384 | C ------------------------- |
---|
1385 | C |
---|
1386 | 320 CONTINUE |
---|
1387 | C |
---|
1388 | DO 324 JK = 2 , KFLEV+1 |
---|
1389 | JKM1 = JK - 1 |
---|
1390 | IKL=KFLEV+1-JKM1 |
---|
1391 | DO 322 JL = 1, KDLON |
---|
1392 | ZRNEB(JL) = PCLD(JL,JKM1) |
---|
1393 | IF (JABS.EQ.1 .AND. ZRNEB(JL).GT.2.*ZEELOG) THEN |
---|
1394 | ZWH2O=MAX(PWV(JL,JKM1),ZEELOG) |
---|
1395 | ZCNEB=MAX(ZEELOG,MIN(ZRNEB(JL),1.-ZEELOG)) |
---|
1396 | ZBB=PUD(JL,JABS,JKM1)*PQS(JL,JKM1)/ZWH2O |
---|
1397 | ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(1.-ZCNEB),ZEELOG) |
---|
1398 | ELSE |
---|
1399 | ZAA=PUD(JL,JABS,JKM1) |
---|
1400 | ZBB=ZAA |
---|
1401 | END IF |
---|
1402 | ZRKI = PAKI(JL,JABS) |
---|
1403 | ZS(JL) = EXP(-ZRKI * ZAA * 1.66) |
---|
1404 | ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK)) |
---|
1405 | ZTR1(JL) = 0. |
---|
1406 | ZRE1(JL) = 0. |
---|
1407 | ZTR2(JL) = 0. |
---|
1408 | ZRE2(JL) = 0. |
---|
1409 | C |
---|
1410 | ZW(JL)= POMEGA(JL,KNU,JKM1) |
---|
1411 | ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL) |
---|
1412 | S + ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1) |
---|
1413 | S + ZBB * ZRKI |
---|
1414 | |
---|
1415 | ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1) |
---|
1416 | ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL) |
---|
1417 | ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1) |
---|
1418 | S + (1. - ZR22(JL)) * ZCGAZ(JL,JKM1) |
---|
1419 | ZW(JL) = ZR21(JL) / ZTO1(JL) |
---|
1420 | ZREF(JL) = ZREFZ(JL,1,JKM1) |
---|
1421 | ZRMUZ(JL) = ZRMUE(JL,JK) |
---|
1422 | 322 CONTINUE |
---|
1423 | C |
---|
1424 | CALL SWDE(ZGG, ZREF, ZRMUZ, ZTO1, ZW, |
---|
1425 | S ZRE1, ZRE2, ZTR1, ZTR2) |
---|
1426 | C |
---|
1427 | DO 323 JL = 1, KDLON |
---|
1428 | C |
---|
1429 | ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1) |
---|
1430 | S + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1) |
---|
1431 | S * ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL) |
---|
1432 | S + ZRNEB(JL) * ZRE1(JL) |
---|
1433 | C |
---|
1434 | ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL) |
---|
1435 | S + (ZTRA1(JL,JKM1)) * ZG(JL) * (1.-ZRNEB(JL)) |
---|
1436 | C |
---|
1437 | ZREFZ(JL,1,JK)=(1.-ZRNEB(JL))*(ZRAY1(JL,JKM1) |
---|
1438 | S +ZREFZ(JL,1,JKM1)*ZTRA1(JL,JKM1)*ZTRA2(JL,JKM1) |
---|
1439 | S /(1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))*ZG(JL)*ZS(JL) |
---|
1440 | S + ZRNEB(JL) * ZRE2(JL) |
---|
1441 | C |
---|
1442 | ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL) |
---|
1443 | S + (ZTRA1(JL,JKM1)/(1.-ZRAY2(JL,JKM1) |
---|
1444 | S * ZREFZ(JL,1,JKM1))) |
---|
1445 | S * ZG(JL) * (1. -ZRNEB(JL)) |
---|
1446 | C |
---|
1447 | 323 CONTINUE |
---|
1448 | 324 CONTINUE |
---|
1449 | C |
---|
1450 | C* 3.3 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
---|
1451 | C ------------------------------------------------- |
---|
1452 | C |
---|
1453 | 330 CONTINUE |
---|
1454 | C |
---|
1455 | DO 351 JREF=1,2 |
---|
1456 | C |
---|
1457 | JN = JN + 1 |
---|
1458 | C |
---|
1459 | DO 331 JL = 1, KDLON |
---|
1460 | ZRJ(JL,JN,KFLEV+1) = 1. |
---|
1461 | ZRK(JL,JN,KFLEV+1) = ZREFZ(JL,JREF,KFLEV+1) |
---|
1462 | 331 CONTINUE |
---|
1463 | C |
---|
1464 | DO 333 JK = 1 , KFLEV |
---|
1465 | JKL = KFLEV+1 - JK |
---|
1466 | JKLP1 = JKL + 1 |
---|
1467 | DO 332 JL = 1, KDLON |
---|
1468 | ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL) |
---|
1469 | ZRJ(JL,JN,JKL) = ZRE11 |
---|
1470 | ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL) |
---|
1471 | 332 CONTINUE |
---|
1472 | 333 CONTINUE |
---|
1473 | 351 CONTINUE |
---|
1474 | 361 CONTINUE |
---|
1475 | C |
---|
1476 | C |
---|
1477 | C ------------------------------------------------------------------ |
---|
1478 | C |
---|
1479 | C* 4. INVERT GREY AND CONTINUUM FLUXES |
---|
1480 | C -------------------------------- |
---|
1481 | C |
---|
1482 | 400 CONTINUE |
---|
1483 | C |
---|
1484 | C |
---|
1485 | C* 4.1 UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES |
---|
1486 | C --------------------------------------------- |
---|
1487 | C |
---|
1488 | 410 CONTINUE |
---|
1489 | C |
---|
1490 | DO 414 JK = 1 , KFLEV+1 |
---|
1491 | DO 413 JAJ = 1 , 5 , 2 |
---|
1492 | JAJP = JAJ + 1 |
---|
1493 | DO 412 JL = 1, KDLON |
---|
1494 | ZRJ(JL,JAJ,JK)= ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK) |
---|
1495 | ZRK(JL,JAJ,JK)= ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK) |
---|
1496 | ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG ) |
---|
1497 | ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG ) |
---|
1498 | 412 CONTINUE |
---|
1499 | 413 CONTINUE |
---|
1500 | 414 CONTINUE |
---|
1501 | C |
---|
1502 | DO 417 JK = 1 , KFLEV+1 |
---|
1503 | DO 416 JAJ = 2 , 6 , 2 |
---|
1504 | DO 415 JL = 1, KDLON |
---|
1505 | ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG ) |
---|
1506 | ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG ) |
---|
1507 | 415 CONTINUE |
---|
1508 | 416 CONTINUE |
---|
1509 | 417 CONTINUE |
---|
1510 | C |
---|
1511 | C* 4.2 EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE |
---|
1512 | C --------------------------------------------- |
---|
1513 | C |
---|
1514 | 420 CONTINUE |
---|
1515 | C |
---|
1516 | DO 437 JK = 1 , KFLEV+1 |
---|
1517 | JKKI = 1 |
---|
1518 | DO 425 JAJ = 1 , 2 |
---|
1519 | IIND2(1)=JAJ |
---|
1520 | IIND2(2)=JAJ |
---|
1521 | DO 424 JN = 1 , 2 |
---|
1522 | JN2J = JN + 2 * JAJ |
---|
1523 | JKKP4 = JKKI + 4 |
---|
1524 | C |
---|
1525 | C* 4.2.1 EFFECTIVE ABSORBER AMOUNTS |
---|
1526 | C -------------------------- |
---|
1527 | C |
---|
1528 | 4210 CONTINUE |
---|
1529 | C |
---|
1530 | DO 4211 JL = 1, KDLON |
---|
1531 | ZW2(JL,1) = LOG( ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK)) |
---|
1532 | S / PAKI(JL,JAJ) |
---|
1533 | ZW2(JL,2) = LOG( ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK)) |
---|
1534 | S / PAKI(JL,JAJ) |
---|
1535 | 4211 CONTINUE |
---|
1536 | C |
---|
1537 | C* 4.2.2 TRANSMISSION FUNCTION |
---|
1538 | C --------------------- |
---|
1539 | C |
---|
1540 | 4220 CONTINUE |
---|
1541 | C |
---|
1542 | CALL SWTT1(KNU, 2, IIND2, ZW2, ZR2) |
---|
1543 | C |
---|
1544 | DO 4221 JL = 1, KDLON |
---|
1545 | ZRL(JL,JKKI) = ZR2(JL,1) |
---|
1546 | ZRUEF(JL,JKKI) = ZW2(JL,1) |
---|
1547 | ZRL(JL,JKKP4) = ZR2(JL,2) |
---|
1548 | ZRUEF(JL,JKKP4) = ZW2(JL,2) |
---|
1549 | 4221 CONTINUE |
---|
1550 | C |
---|
1551 | JKKI=JKKI+1 |
---|
1552 | 424 CONTINUE |
---|
1553 | 425 CONTINUE |
---|
1554 | C |
---|
1555 | C* 4.3 UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION |
---|
1556 | C ------------------------------------------------------ |
---|
1557 | C |
---|
1558 | 430 CONTINUE |
---|
1559 | C |
---|
1560 | DO 431 JL = 1, KDLON |
---|
1561 | PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3) |
---|
1562 | S + ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4) |
---|
1563 | PFUP(JL,JK) = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7) |
---|
1564 | S + ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8) |
---|
1565 | 431 CONTINUE |
---|
1566 | 437 CONTINUE |
---|
1567 | C |
---|
1568 | C |
---|
1569 | C ------------------------------------------------------------------ |
---|
1570 | C |
---|
1571 | C* 5. MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES |
---|
1572 | C ---------------------------------------- |
---|
1573 | C |
---|
1574 | 500 CONTINUE |
---|
1575 | C |
---|
1576 | C |
---|
1577 | C* 5.1 DOWNWARD FLUXES |
---|
1578 | C --------------- |
---|
1579 | C |
---|
1580 | 510 CONTINUE |
---|
1581 | C |
---|
1582 | JAJ = 2 |
---|
1583 | IIND3(1)=1 |
---|
1584 | IIND3(2)=2 |
---|
1585 | IIND3(3)=3 |
---|
1586 | C |
---|
1587 | DO 511 JL = 1, KDLON |
---|
1588 | ZW3(JL,1)=0. |
---|
1589 | ZW3(JL,2)=0. |
---|
1590 | ZW3(JL,3)=0. |
---|
1591 | ZW4(JL) =0. |
---|
1592 | ZW5(JL) =0. |
---|
1593 | ZR4(JL) =1. |
---|
1594 | ZFD(JL,KFLEV+1)= ZRJ0(JL,JAJ,KFLEV+1) |
---|
1595 | 511 CONTINUE |
---|
1596 | DO 514 JK = 1 , KFLEV |
---|
1597 | IKL = KFLEV+1-JK |
---|
1598 | DO 512 JL = 1, KDLON |
---|
1599 | ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)/ZRMU0(JL,IKL) |
---|
1600 | ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)/ZRMU0(JL,IKL) |
---|
1601 | ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKL)/ZRMU0(JL,IKL) |
---|
1602 | ZW4(JL) =ZW4(JL) +PUD(JL,4,IKL)/ZRMU0(JL,IKL) |
---|
1603 | ZW5(JL) =ZW5(JL) +PUD(JL,5,IKL)/ZRMU0(JL,IKL) |
---|
1604 | 512 CONTINUE |
---|
1605 | C |
---|
1606 | CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3) |
---|
1607 | C |
---|
1608 | DO 513 JL = 1, KDLON |
---|
1609 | C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
---|
1610 | ZFD(JL,IKL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL) |
---|
1611 | S * ZRJ0(JL,JAJ,IKL) |
---|
1612 | 513 CONTINUE |
---|
1613 | 514 CONTINUE |
---|
1614 | C |
---|
1615 | C |
---|
1616 | C* 5.2 UPWARD FLUXES |
---|
1617 | C ------------- |
---|
1618 | C |
---|
1619 | 520 CONTINUE |
---|
1620 | C |
---|
1621 | DO 525 JL = 1, KDLON |
---|
1622 | ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU) |
---|
1623 | 525 CONTINUE |
---|
1624 | C |
---|
1625 | DO 528 JK = 2 , KFLEV+1 |
---|
1626 | IKM1=JK-1 |
---|
1627 | DO 526 JL = 1, KDLON |
---|
1628 | ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66 |
---|
1629 | ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66 |
---|
1630 | ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKM1)*1.66 |
---|
1631 | ZW4(JL) =ZW4(JL) +PUD(JL,4,IKM1)*1.66 |
---|
1632 | ZW5(JL) =ZW5(JL) +PUD(JL,5,IKM1)*1.66 |
---|
1633 | 526 CONTINUE |
---|
1634 | C |
---|
1635 | CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3) |
---|
1636 | C |
---|
1637 | DO 527 JL = 1, KDLON |
---|
1638 | C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
---|
1639 | ZFU(JL,JK) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL) |
---|
1640 | S * ZRK0(JL,JAJ,JK) |
---|
1641 | 527 CONTINUE |
---|
1642 | 528 CONTINUE |
---|
1643 | C |
---|
1644 | C |
---|
1645 | C ------------------------------------------------------------------ |
---|
1646 | C |
---|
1647 | C* 6. INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION |
---|
1648 | C -------------------------------------------------- |
---|
1649 | C |
---|
1650 | 600 CONTINUE |
---|
1651 | IABS=3 |
---|
1652 | C |
---|
1653 | C* 6.1 DOWNWARD FLUXES |
---|
1654 | C --------------- |
---|
1655 | C |
---|
1656 | 610 CONTINUE |
---|
1657 | DO 611 JL = 1, KDLON |
---|
1658 | ZW1(JL)=0. |
---|
1659 | ZW4(JL)=0. |
---|
1660 | ZW5(JL)=0. |
---|
1661 | ZR1(JL)=0. |
---|
1662 | PFDOWN(JL,KFLEV+1) = ((1.-PCLEAR(JL))*PFDOWN(JL,KFLEV+1) |
---|
1663 | S + PCLEAR(JL) * ZFD(JL,KFLEV+1)) * RSUN(KNU) |
---|
1664 | 611 CONTINUE |
---|
1665 | C |
---|
1666 | DO 614 JK = 1 , KFLEV |
---|
1667 | IKL=KFLEV+1-JK |
---|
1668 | DO 612 JL = 1, KDLON |
---|
1669 | ZW1(JL) = ZW1(JL)+POZ(JL, IKL)/ZRMUE(JL,IKL) |
---|
1670 | ZW4(JL) = ZW4(JL)+PUD(JL,4,IKL)/ZRMUE(JL,IKL) |
---|
1671 | ZW5(JL) = ZW5(JL)+PUD(JL,5,IKL)/ZRMUE(JL,IKL) |
---|
1672 | C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
---|
1673 | 612 CONTINUE |
---|
1674 | C |
---|
1675 | CALL SWTT(KNU, IABS, ZW1, ZR1) |
---|
1676 | C |
---|
1677 | DO 613 JL = 1, KDLON |
---|
1678 | PFDOWN(JL,IKL) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL)*PFDOWN(JL,IKL) |
---|
1679 | S +PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU) |
---|
1680 | 613 CONTINUE |
---|
1681 | 614 CONTINUE |
---|
1682 | C |
---|
1683 | C |
---|
1684 | C* 6.2 UPWARD FLUXES |
---|
1685 | C ------------- |
---|
1686 | C |
---|
1687 | 620 CONTINUE |
---|
1688 | DO 621 JL = 1, KDLON |
---|
1689 | PFUP(JL,1) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,1) |
---|
1690 | S +PCLEAR(JL)*ZFU(JL,1)) * RSUN(KNU) |
---|
1691 | 621 CONTINUE |
---|
1692 | C |
---|
1693 | DO 624 JK = 2 , KFLEV+1 |
---|
1694 | IKM1=JK-1 |
---|
1695 | DO 622 JL = 1, KDLON |
---|
1696 | ZW1(JL) = ZW1(JL)+POZ(JL ,IKM1)*1.66 |
---|
1697 | ZW4(JL) = ZW4(JL)+PUD(JL,4,IKM1)*1.66 |
---|
1698 | ZW5(JL) = ZW5(JL)+PUD(JL,5,IKM1)*1.66 |
---|
1699 | C ZR4(JL) = EXP(-RSWCE*ZW4(JL)-RSWCP*ZW5(JL)) |
---|
1700 | 622 CONTINUE |
---|
1701 | C |
---|
1702 | CALL SWTT(KNU, IABS, ZW1, ZR1) |
---|
1703 | C |
---|
1704 | DO 623 JL = 1, KDLON |
---|
1705 | PFUP(JL,JK) = ((1.-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,JK) |
---|
1706 | S +PCLEAR(JL)*ZFU(JL,JK)) * RSUN(KNU) |
---|
1707 | 623 CONTINUE |
---|
1708 | 624 CONTINUE |
---|
1709 | C |
---|
1710 | C ------------------------------------------------------------------ |
---|
1711 | C |
---|
1712 | RETURN |
---|
1713 | END |
---|
1714 | SUBROUTINE SWCLR ( KNU |
---|
1715 | S , PAER , flag_aer, tauae, pizae, cgae |
---|
1716 | S , PALBP , PDSIG , PRAYL , PSEC |
---|
1717 | S , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ |
---|
1718 | S , PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 ) |
---|
1719 | USE dimphy |
---|
1720 | IMPLICIT none |
---|
1721 | cym#include "dimensions.h" |
---|
1722 | cym#include "dimphy.h" |
---|
1723 | cym#include "raddim.h" |
---|
1724 | #include "radepsi.h" |
---|
1725 | #include "radopt.h" |
---|
1726 | C |
---|
1727 | C ------------------------------------------------------------------ |
---|
1728 | C PURPOSE. |
---|
1729 | C -------- |
---|
1730 | C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF |
---|
1731 | C CLEAR-SKY COLUMN |
---|
1732 | C |
---|
1733 | C REFERENCE. |
---|
1734 | C ---------- |
---|
1735 | C |
---|
1736 | C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
---|
1737 | C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
---|
1738 | C |
---|
1739 | C AUTHOR. |
---|
1740 | C ------- |
---|
1741 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
1742 | C |
---|
1743 | C MODIFICATIONS. |
---|
1744 | C -------------- |
---|
1745 | C ORIGINAL : 94-11-15 |
---|
1746 | C ------------------------------------------------------------------ |
---|
1747 | C* ARGUMENTS: |
---|
1748 | C |
---|
1749 | INTEGER KNU |
---|
1750 | c-OB |
---|
1751 | real*8 flag_aer |
---|
1752 | real*8 tauae(kdlon,kflev,2) |
---|
1753 | real*8 pizae(kdlon,kflev,2) |
---|
1754 | real*8 cgae(kdlon,kflev,2) |
---|
1755 | REAL*8 PAER(KDLON,KFLEV,5) |
---|
1756 | REAL*8 PALBP(KDLON,2) |
---|
1757 | REAL*8 PDSIG(KDLON,KFLEV) |
---|
1758 | REAL*8 PRAYL(KDLON) |
---|
1759 | REAL*8 PSEC(KDLON) |
---|
1760 | C |
---|
1761 | REAL*8 PCGAZ(KDLON,KFLEV) |
---|
1762 | REAL*8 PPIZAZ(KDLON,KFLEV) |
---|
1763 | REAL*8 PRAY1(KDLON,KFLEV+1) |
---|
1764 | REAL*8 PRAY2(KDLON,KFLEV+1) |
---|
1765 | REAL*8 PREFZ(KDLON,2,KFLEV+1) |
---|
1766 | REAL*8 PRJ(KDLON,6,KFLEV+1) |
---|
1767 | REAL*8 PRK(KDLON,6,KFLEV+1) |
---|
1768 | REAL*8 PRMU0(KDLON,KFLEV+1) |
---|
1769 | REAL*8 PTAUAZ(KDLON,KFLEV) |
---|
1770 | REAL*8 PTRA1(KDLON,KFLEV+1) |
---|
1771 | REAL*8 PTRA2(KDLON,KFLEV+1) |
---|
1772 | C |
---|
1773 | C* LOCAL VARIABLES: |
---|
1774 | C |
---|
1775 | REAL*8 ZC0I(KDLON,KFLEV+1) |
---|
1776 | REAL*8 ZCLE0(KDLON,KFLEV) |
---|
1777 | REAL*8 ZCLEAR(KDLON) |
---|
1778 | REAL*8 ZR21(KDLON) |
---|
1779 | REAL*8 ZR23(KDLON) |
---|
1780 | REAL*8 ZSS0(KDLON) |
---|
1781 | REAL*8 ZSCAT(KDLON) |
---|
1782 | REAL*8 ZTR(KDLON,2,KFLEV+1) |
---|
1783 | C |
---|
1784 | INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in |
---|
1785 | REAL*8 ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE |
---|
1786 | REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1 |
---|
1787 | REAL*8 ZBMU0, ZBMU1, ZRE11 |
---|
1788 | C |
---|
1789 | C* Prescribed Data for Aerosols: |
---|
1790 | C |
---|
1791 | REAL*8 TAUA(2,5), RPIZA(2,5), RCGA(2,5) |
---|
1792 | SAVE TAUA, RPIZA, RCGA |
---|
1793 | c$OMP THREADPRIVATE(TAUA, RPIZA, RCGA) |
---|
1794 | DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) / |
---|
1795 | S .730719, .912819, .725059, .745405, .682188 , |
---|
1796 | S .730719, .912819, .725059, .745405, .682188 / |
---|
1797 | DATA ((RPIZA(IN,JA),JA=1,5),IN=1,2) / |
---|
1798 | S .872212, .982545, .623143, .944887, .997975 , |
---|
1799 | S .872212, .982545, .623143, .944887, .997975 / |
---|
1800 | DATA ((RCGA (IN,JA),JA=1,5),IN=1,2) / |
---|
1801 | S .647596, .739002, .580845, .662657, .624246 , |
---|
1802 | S .647596, .739002, .580845, .662657, .624246 / |
---|
1803 | C ------------------------------------------------------------------ |
---|
1804 | C |
---|
1805 | C* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH |
---|
1806 | C -------------------------------------------- |
---|
1807 | C |
---|
1808 | 100 CONTINUE |
---|
1809 | C |
---|
1810 | DO 103 JK = 1 , KFLEV+1 |
---|
1811 | DO 102 JA = 1 , 6 |
---|
1812 | DO 101 JL = 1, KDLON |
---|
1813 | PRJ(JL,JA,JK) = 0. |
---|
1814 | PRK(JL,JA,JK) = 0. |
---|
1815 | 101 CONTINUE |
---|
1816 | 102 CONTINUE |
---|
1817 | 103 CONTINUE |
---|
1818 | C |
---|
1819 | DO 108 JK = 1 , KFLEV |
---|
1820 | c-OB |
---|
1821 | c DO 104 JL = 1, KDLON |
---|
1822 | c PCGAZ(JL,JK) = 0. |
---|
1823 | c PPIZAZ(JL,JK) = 0. |
---|
1824 | c PTAUAZ(JL,JK) = 0. |
---|
1825 | c 104 CONTINUE |
---|
1826 | c-OB |
---|
1827 | c DO 106 JAE=1,5 |
---|
1828 | c DO 105 JL = 1, KDLON |
---|
1829 | c PTAUAZ(JL,JK)=PTAUAZ(JL,JK) |
---|
1830 | c S +PAER(JL,JK,JAE)*TAUA(KNU,JAE) |
---|
1831 | c PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE) |
---|
1832 | c S * TAUA(KNU,JAE)*RPIZA(KNU,JAE) |
---|
1833 | c PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JK,JAE) |
---|
1834 | c S * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) |
---|
1835 | c 105 CONTINUE |
---|
1836 | c 106 CONTINUE |
---|
1837 | c-OB |
---|
1838 | DO 105 JL = 1, KDLON |
---|
1839 | PTAUAZ(JL,JK)=flag_aer * tauae(JL,JK,KNU) |
---|
1840 | PPIZAZ(JL,JK)=flag_aer * pizae(JL,JK,KNU) |
---|
1841 | PCGAZ (JL,JK)=flag_aer * cgae(JL,JK,KNU) |
---|
1842 | 105 CONTINUE |
---|
1843 | C |
---|
1844 | IF (flag_aer.GT.0) THEN |
---|
1845 | c-OB |
---|
1846 | DO 107 JL = 1, KDLON |
---|
1847 | c PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK) |
---|
1848 | c PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK) |
---|
1849 | ZTRAY = PRAYL(JL) * PDSIG(JL,JK) |
---|
1850 | ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK)) |
---|
1851 | ZGAR = PCGAZ(JL,JK) |
---|
1852 | ZFF = ZGAR * ZGAR |
---|
1853 | PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.-PPIZAZ(JL,JK)*ZFF) |
---|
1854 | PCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR) |
---|
1855 | PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*PPIZAZ(JL,JK)*(1.-ZFF) |
---|
1856 | S / (1. - PPIZAZ(JL,JK) * ZFF) |
---|
1857 | 107 CONTINUE |
---|
1858 | ELSE |
---|
1859 | DO JL = 1, KDLON |
---|
1860 | ZTRAY = PRAYL(JL) * PDSIG(JL,JK) |
---|
1861 | PTAUAZ(JL,JK) = ZTRAY |
---|
1862 | PCGAZ(JL,JK) = 0. |
---|
1863 | PPIZAZ(JL,JK) = 1.-REPSCT |
---|
1864 | END DO |
---|
1865 | END IF ! check flag_aer |
---|
1866 | c 107 CONTINUE |
---|
1867 | c PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5) |
---|
1868 | c $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON) |
---|
1869 | c 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5) |
---|
1870 | C |
---|
1871 | 108 CONTINUE |
---|
1872 | C |
---|
1873 | C ------------------------------------------------------------------ |
---|
1874 | C |
---|
1875 | C* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL |
---|
1876 | C ---------------------------------------------- |
---|
1877 | C |
---|
1878 | 200 CONTINUE |
---|
1879 | C |
---|
1880 | DO 201 JL = 1, KDLON |
---|
1881 | ZR23(JL) = 0. |
---|
1882 | ZC0I(JL,KFLEV+1) = 0. |
---|
1883 | ZCLEAR(JL) = 1. |
---|
1884 | ZSCAT(JL) = 0. |
---|
1885 | 201 CONTINUE |
---|
1886 | C |
---|
1887 | JK = 1 |
---|
1888 | JKL = KFLEV+1 - JK |
---|
1889 | JKLP1 = JKL + 1 |
---|
1890 | DO 202 JL = 1, KDLON |
---|
1891 | ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
---|
1892 | ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
---|
1893 | ZR21(JL) = EXP(-ZCORAE ) |
---|
1894 | ZSS0(JL) = 1.-ZR21(JL) |
---|
1895 | ZCLE0(JL,JKL) = ZSS0(JL) |
---|
1896 | C |
---|
1897 | IF (NOVLP.EQ.1) THEN |
---|
1898 | c* maximum-random |
---|
1899 | ZCLEAR(JL) = ZCLEAR(JL) |
---|
1900 | S *(1.0-MAX(ZSS0(JL),ZSCAT(JL))) |
---|
1901 | S /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC)) |
---|
1902 | ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL) |
---|
1903 | ZSCAT(JL) = ZSS0(JL) |
---|
1904 | ELSE IF (NOVLP.EQ.2) THEN |
---|
1905 | C* maximum |
---|
1906 | ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) ) |
---|
1907 | ZC0I(JL,JKL) = ZSCAT(JL) |
---|
1908 | ELSE IF (NOVLP.EQ.3) THEN |
---|
1909 | c* random |
---|
1910 | ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL)) |
---|
1911 | ZSCAT(JL) = 1.0 - ZCLEAR(JL) |
---|
1912 | ZC0I(JL,JKL) = ZSCAT(JL) |
---|
1913 | END IF |
---|
1914 | 202 CONTINUE |
---|
1915 | C |
---|
1916 | DO 205 JK = 2 , KFLEV |
---|
1917 | JKL = KFLEV+1 - JK |
---|
1918 | JKLP1 = JKL + 1 |
---|
1919 | DO 204 JL = 1, KDLON |
---|
1920 | ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
---|
1921 | ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
---|
1922 | ZR21(JL) = EXP(-ZCORAE ) |
---|
1923 | ZSS0(JL) = 1.-ZR21(JL) |
---|
1924 | ZCLE0(JL,JKL) = ZSS0(JL) |
---|
1925 | c |
---|
1926 | IF (NOVLP.EQ.1) THEN |
---|
1927 | c* maximum-random |
---|
1928 | ZCLEAR(JL) = ZCLEAR(JL) |
---|
1929 | S *(1.0-MAX(ZSS0(JL),ZSCAT(JL))) |
---|
1930 | S /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC)) |
---|
1931 | ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL) |
---|
1932 | ZSCAT(JL) = ZSS0(JL) |
---|
1933 | ELSE IF (NOVLP.EQ.2) THEN |
---|
1934 | C* maximum |
---|
1935 | ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) ) |
---|
1936 | ZC0I(JL,JKL) = ZSCAT(JL) |
---|
1937 | ELSE IF (NOVLP.EQ.3) THEN |
---|
1938 | c* random |
---|
1939 | ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL)) |
---|
1940 | ZSCAT(JL) = 1.0 - ZCLEAR(JL) |
---|
1941 | ZC0I(JL,JKL) = ZSCAT(JL) |
---|
1942 | END IF |
---|
1943 | 204 CONTINUE |
---|
1944 | 205 CONTINUE |
---|
1945 | C |
---|
1946 | C ------------------------------------------------------------------ |
---|
1947 | C |
---|
1948 | C* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING |
---|
1949 | C ----------------------------------------------- |
---|
1950 | C |
---|
1951 | 300 CONTINUE |
---|
1952 | C |
---|
1953 | DO 301 JL = 1, KDLON |
---|
1954 | PRAY1(JL,KFLEV+1) = 0. |
---|
1955 | PRAY2(JL,KFLEV+1) = 0. |
---|
1956 | PREFZ(JL,2,1) = PALBP(JL,KNU) |
---|
1957 | PREFZ(JL,1,1) = PALBP(JL,KNU) |
---|
1958 | PTRA1(JL,KFLEV+1) = 1. |
---|
1959 | PTRA2(JL,KFLEV+1) = 1. |
---|
1960 | 301 CONTINUE |
---|
1961 | C |
---|
1962 | DO 346 JK = 2 , KFLEV+1 |
---|
1963 | JKM1 = JK-1 |
---|
1964 | DO 342 JL = 1, KDLON |
---|
1965 | C |
---|
1966 | C |
---|
1967 | C ------------------------------------------------------------------ |
---|
1968 | C |
---|
1969 | C* 3.1 EQUIVALENT ZENITH ANGLE |
---|
1970 | C ----------------------- |
---|
1971 | C |
---|
1972 | 310 CONTINUE |
---|
1973 | C |
---|
1974 | ZMUE = (1.-ZC0I(JL,JK)) * PSEC(JL) |
---|
1975 | S + ZC0I(JL,JK) * 1.66 |
---|
1976 | PRMU0(JL,JK) = 1./ZMUE |
---|
1977 | C |
---|
1978 | C |
---|
1979 | C ------------------------------------------------------------------ |
---|
1980 | C |
---|
1981 | C* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS |
---|
1982 | C ---------------------------------------------------- |
---|
1983 | C |
---|
1984 | 320 CONTINUE |
---|
1985 | C |
---|
1986 | ZGAP = PCGAZ(JL,JKM1) |
---|
1987 | ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE |
---|
1988 | ZWW = PPIZAZ(JL,JKM1) |
---|
1989 | ZTO = PTAUAZ(JL,JKM1) |
---|
1990 | ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE |
---|
1991 | S + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE |
---|
1992 | PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN |
---|
1993 | PTRA1(JL,JKM1) = 1. / ZDEN |
---|
1994 | C |
---|
1995 | ZMU1 = 0.5 |
---|
1996 | ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1 |
---|
1997 | ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1 |
---|
1998 | S + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1 |
---|
1999 | PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1 |
---|
2000 | PTRA2(JL,JKM1) = 1. / ZDEN1 |
---|
2001 | C |
---|
2002 | C |
---|
2003 | C |
---|
2004 | PREFZ(JL,1,JK) = (PRAY1(JL,JKM1) |
---|
2005 | S + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1) |
---|
2006 | S * PTRA2(JL,JKM1) |
---|
2007 | S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
---|
2008 | C |
---|
2009 | ZTR(JL,1,JKM1) = (PTRA1(JL,JKM1) |
---|
2010 | S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
---|
2011 | C |
---|
2012 | PREFZ(JL,2,JK) = (PRAY1(JL,JKM1) |
---|
2013 | S + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1) |
---|
2014 | S * PTRA2(JL,JKM1) ) |
---|
2015 | C |
---|
2016 | ZTR(JL,2,JKM1) = PTRA1(JL,JKM1) |
---|
2017 | C |
---|
2018 | 342 CONTINUE |
---|
2019 | 346 CONTINUE |
---|
2020 | DO 347 JL = 1, KDLON |
---|
2021 | ZMUE = (1.-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66 |
---|
2022 | PRMU0(JL,1)=1./ZMUE |
---|
2023 | 347 CONTINUE |
---|
2024 | C |
---|
2025 | C |
---|
2026 | C ------------------------------------------------------------------ |
---|
2027 | C |
---|
2028 | C* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
---|
2029 | C ------------------------------------------------- |
---|
2030 | C |
---|
2031 | 350 CONTINUE |
---|
2032 | C |
---|
2033 | IF (KNU.EQ.1) THEN |
---|
2034 | JAJ = 2 |
---|
2035 | DO 351 JL = 1, KDLON |
---|
2036 | PRJ(JL,JAJ,KFLEV+1) = 1. |
---|
2037 | PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1) |
---|
2038 | 351 CONTINUE |
---|
2039 | C |
---|
2040 | DO 353 JK = 1 , KFLEV |
---|
2041 | JKL = KFLEV+1 - JK |
---|
2042 | JKLP1 = JKL + 1 |
---|
2043 | DO 352 JL = 1, KDLON |
---|
2044 | ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL) |
---|
2045 | PRJ(JL,JAJ,JKL) = ZRE11 |
---|
2046 | PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL) |
---|
2047 | 352 CONTINUE |
---|
2048 | 353 CONTINUE |
---|
2049 | 354 CONTINUE |
---|
2050 | C |
---|
2051 | ELSE |
---|
2052 | C |
---|
2053 | DO 358 JAJ = 1 , 2 |
---|
2054 | DO 355 JL = 1, KDLON |
---|
2055 | PRJ(JL,JAJ,KFLEV+1) = 1. |
---|
2056 | PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1) |
---|
2057 | 355 CONTINUE |
---|
2058 | C |
---|
2059 | DO 357 JK = 1 , KFLEV |
---|
2060 | JKL = KFLEV+1 - JK |
---|
2061 | JKLP1 = JKL + 1 |
---|
2062 | DO 356 JL = 1, KDLON |
---|
2063 | ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL) |
---|
2064 | PRJ(JL,JAJ,JKL) = ZRE11 |
---|
2065 | PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL) |
---|
2066 | 356 CONTINUE |
---|
2067 | 357 CONTINUE |
---|
2068 | 358 CONTINUE |
---|
2069 | C |
---|
2070 | END IF |
---|
2071 | C |
---|
2072 | C ------------------------------------------------------------------ |
---|
2073 | C |
---|
2074 | RETURN |
---|
2075 | END |
---|
2076 | SUBROUTINE SWR ( KNU |
---|
2077 | S , PALBD , PCG , PCLD , PDSIG, POMEGA, PRAYL |
---|
2078 | S , PSEC , PTAU |
---|
2079 | S , PCGAZ , PPIZAZ, PRAY1, PRAY2, PREFZ , PRJ , PRK , PRMUE |
---|
2080 | S , PTAUAZ, PTRA1 , PTRA2 ) |
---|
2081 | USE dimphy |
---|
2082 | IMPLICIT none |
---|
2083 | cym#include "dimensions.h" |
---|
2084 | cym#include "dimphy.h" |
---|
2085 | cym#include "raddim.h" |
---|
2086 | #include "radepsi.h" |
---|
2087 | #include "radopt.h" |
---|
2088 | C |
---|
2089 | C ------------------------------------------------------------------ |
---|
2090 | C PURPOSE. |
---|
2091 | C -------- |
---|
2092 | C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF |
---|
2093 | C CONTINUUM SCATTERING |
---|
2094 | C |
---|
2095 | C METHOD. |
---|
2096 | C ------- |
---|
2097 | C |
---|
2098 | C 1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL |
---|
2099 | C OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION) |
---|
2100 | C |
---|
2101 | C REFERENCE. |
---|
2102 | C ---------- |
---|
2103 | C |
---|
2104 | C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
---|
2105 | C DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
---|
2106 | C |
---|
2107 | C AUTHOR. |
---|
2108 | C ------- |
---|
2109 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
2110 | C |
---|
2111 | C MODIFICATIONS. |
---|
2112 | C -------------- |
---|
2113 | C ORIGINAL : 89-07-14 |
---|
2114 | C ------------------------------------------------------------------ |
---|
2115 | C* ARGUMENTS: |
---|
2116 | C |
---|
2117 | INTEGER KNU |
---|
2118 | REAL*8 PALBD(KDLON,2) |
---|
2119 | REAL*8 PCG(KDLON,2,KFLEV) |
---|
2120 | REAL*8 PCLD(KDLON,KFLEV) |
---|
2121 | REAL*8 PDSIG(KDLON,KFLEV) |
---|
2122 | REAL*8 POMEGA(KDLON,2,KFLEV) |
---|
2123 | REAL*8 PRAYL(KDLON) |
---|
2124 | REAL*8 PSEC(KDLON) |
---|
2125 | REAL*8 PTAU(KDLON,2,KFLEV) |
---|
2126 | C |
---|
2127 | REAL*8 PRAY1(KDLON,KFLEV+1) |
---|
2128 | REAL*8 PRAY2(KDLON,KFLEV+1) |
---|
2129 | REAL*8 PREFZ(KDLON,2,KFLEV+1) |
---|
2130 | REAL*8 PRJ(KDLON,6,KFLEV+1) |
---|
2131 | REAL*8 PRK(KDLON,6,KFLEV+1) |
---|
2132 | REAL*8 PRMUE(KDLON,KFLEV+1) |
---|
2133 | REAL*8 PCGAZ(KDLON,KFLEV) |
---|
2134 | REAL*8 PPIZAZ(KDLON,KFLEV) |
---|
2135 | REAL*8 PTAUAZ(KDLON,KFLEV) |
---|
2136 | REAL*8 PTRA1(KDLON,KFLEV+1) |
---|
2137 | REAL*8 PTRA2(KDLON,KFLEV+1) |
---|
2138 | C |
---|
2139 | C* LOCAL VARIABLES: |
---|
2140 | C |
---|
2141 | REAL*8 ZC1I(KDLON,KFLEV+1) |
---|
2142 | REAL*8 ZCLEQ(KDLON,KFLEV) |
---|
2143 | REAL*8 ZCLEAR(KDLON) |
---|
2144 | REAL*8 ZCLOUD(KDLON) |
---|
2145 | REAL*8 ZGG(KDLON) |
---|
2146 | REAL*8 ZREF(KDLON) |
---|
2147 | REAL*8 ZRE1(KDLON) |
---|
2148 | REAL*8 ZRE2(KDLON) |
---|
2149 | REAL*8 ZRMUZ(KDLON) |
---|
2150 | REAL*8 ZRNEB(KDLON) |
---|
2151 | REAL*8 ZR21(KDLON) |
---|
2152 | REAL*8 ZR22(KDLON) |
---|
2153 | REAL*8 ZR23(KDLON) |
---|
2154 | REAL*8 ZSS1(KDLON) |
---|
2155 | REAL*8 ZTO1(KDLON) |
---|
2156 | REAL*8 ZTR(KDLON,2,KFLEV+1) |
---|
2157 | REAL*8 ZTR1(KDLON) |
---|
2158 | REAL*8 ZTR2(KDLON) |
---|
2159 | REAL*8 ZW(KDLON) |
---|
2160 | C |
---|
2161 | INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj |
---|
2162 | REAL*8 ZFACOA, ZFACOC, ZCORAE, ZCORCD |
---|
2163 | REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZDEN1 |
---|
2164 | REAL*8 ZMU1, ZRE11, ZBMU0, ZBMU1 |
---|
2165 | C |
---|
2166 | C ------------------------------------------------------------------ |
---|
2167 | C |
---|
2168 | C* 1. INITIALIZATION |
---|
2169 | C -------------- |
---|
2170 | C |
---|
2171 | 100 CONTINUE |
---|
2172 | C |
---|
2173 | DO 103 JK = 1 , KFLEV+1 |
---|
2174 | DO 102 JA = 1 , 6 |
---|
2175 | DO 101 JL = 1, KDLON |
---|
2176 | PRJ(JL,JA,JK) = 0. |
---|
2177 | PRK(JL,JA,JK) = 0. |
---|
2178 | 101 CONTINUE |
---|
2179 | 102 CONTINUE |
---|
2180 | 103 CONTINUE |
---|
2181 | C |
---|
2182 | C |
---|
2183 | C ------------------------------------------------------------------ |
---|
2184 | C |
---|
2185 | C* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL |
---|
2186 | C ---------------------------------------------- |
---|
2187 | C |
---|
2188 | 200 CONTINUE |
---|
2189 | C |
---|
2190 | DO 201 JL = 1, KDLON |
---|
2191 | ZR23(JL) = 0. |
---|
2192 | ZC1I(JL,KFLEV+1) = 0. |
---|
2193 | ZCLEAR(JL) = 1. |
---|
2194 | ZCLOUD(JL) = 0. |
---|
2195 | 201 CONTINUE |
---|
2196 | C |
---|
2197 | JK = 1 |
---|
2198 | JKL = KFLEV+1 - JK |
---|
2199 | JKLP1 = JKL + 1 |
---|
2200 | DO 202 JL = 1, KDLON |
---|
2201 | ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
---|
2202 | ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL) |
---|
2203 | S * PCG(JL,KNU,JKL) |
---|
2204 | ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
---|
2205 | ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL) |
---|
2206 | ZR21(JL) = EXP(-ZCORAE ) |
---|
2207 | ZR22(JL) = EXP(-ZCORCD ) |
---|
2208 | ZSS1(JL) = PCLD(JL,JKL)*(1.0-ZR21(JL)*ZR22(JL)) |
---|
2209 | S + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL)) |
---|
2210 | ZCLEQ(JL,JKL) = ZSS1(JL) |
---|
2211 | C |
---|
2212 | IF (NOVLP.EQ.1) THEN |
---|
2213 | c* maximum-random |
---|
2214 | ZCLEAR(JL) = ZCLEAR(JL) |
---|
2215 | S *(1.0-MAX(ZSS1(JL),ZCLOUD(JL))) |
---|
2216 | S /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
---|
2217 | ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL) |
---|
2218 | ZCLOUD(JL) = ZSS1(JL) |
---|
2219 | ELSE IF (NOVLP.EQ.2) THEN |
---|
2220 | C* maximum |
---|
2221 | ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) ) |
---|
2222 | ZC1I(JL,JKL) = ZCLOUD(JL) |
---|
2223 | ELSE IF (NOVLP.EQ.3) THEN |
---|
2224 | c* random |
---|
2225 | ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL)) |
---|
2226 | ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
---|
2227 | ZC1I(JL,JKL) = ZCLOUD(JL) |
---|
2228 | END IF |
---|
2229 | 202 CONTINUE |
---|
2230 | C |
---|
2231 | DO 205 JK = 2 , KFLEV |
---|
2232 | JKL = KFLEV+1 - JK |
---|
2233 | JKLP1 = JKL + 1 |
---|
2234 | DO 204 JL = 1, KDLON |
---|
2235 | ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL) |
---|
2236 | ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL) |
---|
2237 | S * PCG(JL,KNU,JKL) |
---|
2238 | ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL) |
---|
2239 | ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL) |
---|
2240 | ZR21(JL) = EXP(-ZCORAE ) |
---|
2241 | ZR22(JL) = EXP(-ZCORCD ) |
---|
2242 | ZSS1(JL) = PCLD(JL,JKL)*(1.0-ZR21(JL)*ZR22(JL)) |
---|
2243 | S + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL)) |
---|
2244 | ZCLEQ(JL,JKL) = ZSS1(JL) |
---|
2245 | c |
---|
2246 | IF (NOVLP.EQ.1) THEN |
---|
2247 | c* maximum-random |
---|
2248 | ZCLEAR(JL) = ZCLEAR(JL) |
---|
2249 | S *(1.0-MAX(ZSS1(JL),ZCLOUD(JL))) |
---|
2250 | S /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
---|
2251 | ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL) |
---|
2252 | ZCLOUD(JL) = ZSS1(JL) |
---|
2253 | ELSE IF (NOVLP.EQ.2) THEN |
---|
2254 | C* maximum |
---|
2255 | ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) ) |
---|
2256 | ZC1I(JL,JKL) = ZCLOUD(JL) |
---|
2257 | ELSE IF (NOVLP.EQ.3) THEN |
---|
2258 | c* random |
---|
2259 | ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL)) |
---|
2260 | ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
---|
2261 | ZC1I(JL,JKL) = ZCLOUD(JL) |
---|
2262 | END IF |
---|
2263 | 204 CONTINUE |
---|
2264 | 205 CONTINUE |
---|
2265 | C |
---|
2266 | C ------------------------------------------------------------------ |
---|
2267 | C |
---|
2268 | C* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING |
---|
2269 | C ----------------------------------------------- |
---|
2270 | C |
---|
2271 | 300 CONTINUE |
---|
2272 | C |
---|
2273 | DO 301 JL = 1, KDLON |
---|
2274 | PRAY1(JL,KFLEV+1) = 0. |
---|
2275 | PRAY2(JL,KFLEV+1) = 0. |
---|
2276 | PREFZ(JL,2,1) = PALBD(JL,KNU) |
---|
2277 | PREFZ(JL,1,1) = PALBD(JL,KNU) |
---|
2278 | PTRA1(JL,KFLEV+1) = 1. |
---|
2279 | PTRA2(JL,KFLEV+1) = 1. |
---|
2280 | 301 CONTINUE |
---|
2281 | C |
---|
2282 | DO 346 JK = 2 , KFLEV+1 |
---|
2283 | JKM1 = JK-1 |
---|
2284 | DO 342 JL = 1, KDLON |
---|
2285 | ZRNEB(JL)= PCLD(JL,JKM1) |
---|
2286 | ZRE1(JL)=0. |
---|
2287 | ZTR1(JL)=0. |
---|
2288 | ZRE2(JL)=0. |
---|
2289 | ZTR2(JL)=0. |
---|
2290 | C |
---|
2291 | C |
---|
2292 | C ------------------------------------------------------------------ |
---|
2293 | C |
---|
2294 | C* 3.1 EQUIVALENT ZENITH ANGLE |
---|
2295 | C ----------------------- |
---|
2296 | C |
---|
2297 | 310 CONTINUE |
---|
2298 | C |
---|
2299 | ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL) |
---|
2300 | S + ZC1I(JL,JK) * 1.66 |
---|
2301 | PRMUE(JL,JK) = 1./ZMUE |
---|
2302 | C |
---|
2303 | C |
---|
2304 | C ------------------------------------------------------------------ |
---|
2305 | C |
---|
2306 | C* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS |
---|
2307 | C ---------------------------------------------------- |
---|
2308 | C |
---|
2309 | 320 CONTINUE |
---|
2310 | C |
---|
2311 | ZGAP = PCGAZ(JL,JKM1) |
---|
2312 | ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE |
---|
2313 | ZWW = PPIZAZ(JL,JKM1) |
---|
2314 | ZTO = PTAUAZ(JL,JKM1) |
---|
2315 | ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE |
---|
2316 | S + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE |
---|
2317 | PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN |
---|
2318 | PTRA1(JL,JKM1) = 1. / ZDEN |
---|
2319 | c PRINT *,' LOOP 342 ** 3 ** JL=',JL,PRAY1(JL,JKM1),PTRA1(JL,JKM1) |
---|
2320 | C |
---|
2321 | ZMU1 = 0.5 |
---|
2322 | ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1 |
---|
2323 | ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1 |
---|
2324 | S + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1 |
---|
2325 | PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1 |
---|
2326 | PTRA2(JL,JKM1) = 1. / ZDEN1 |
---|
2327 | C |
---|
2328 | C |
---|
2329 | C ------------------------------------------------------------------ |
---|
2330 | C |
---|
2331 | C* 3.3 EFFECT OF CLOUD LAYER |
---|
2332 | C --------------------- |
---|
2333 | C |
---|
2334 | 330 CONTINUE |
---|
2335 | C |
---|
2336 | ZW(JL) = POMEGA(JL,KNU,JKM1) |
---|
2337 | ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL) |
---|
2338 | S + PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1) |
---|
2339 | ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1) |
---|
2340 | ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL) |
---|
2341 | ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1) |
---|
2342 | S + (1. - ZR22(JL)) * PCGAZ(JL,JKM1) |
---|
2343 | C Modif PhD - JJM 19/03/96 pour erreurs arrondis |
---|
2344 | C machine |
---|
2345 | C PHD PROTECTION ZW(JL) = ZR21(JL) / ZTO1(JL) |
---|
2346 | IF (ZW(JL).EQ.1. .AND. PPIZAZ(JL,JKM1).EQ.1.) THEN |
---|
2347 | ZW(JL)=1. |
---|
2348 | ELSE |
---|
2349 | ZW(JL) = ZR21(JL) / ZTO1(JL) |
---|
2350 | END IF |
---|
2351 | ZREF(JL) = PREFZ(JL,1,JKM1) |
---|
2352 | ZRMUZ(JL) = PRMUE(JL,JK) |
---|
2353 | 342 CONTINUE |
---|
2354 | C |
---|
2355 | CALL SWDE(ZGG , ZREF , ZRMUZ , ZTO1 , ZW, |
---|
2356 | S ZRE1 , ZRE2 , ZTR1 , ZTR2) |
---|
2357 | C |
---|
2358 | DO 345 JL = 1, KDLON |
---|
2359 | C |
---|
2360 | PREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1) |
---|
2361 | S + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1) |
---|
2362 | S * PTRA2(JL,JKM1) |
---|
2363 | S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
---|
2364 | S + ZRNEB(JL) * ZRE2(JL) |
---|
2365 | C |
---|
2366 | ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1) |
---|
2367 | S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))) |
---|
2368 | S * (1.-ZRNEB(JL)) |
---|
2369 | C |
---|
2370 | PREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1) |
---|
2371 | S + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1) |
---|
2372 | S * PTRA2(JL,JKM1) ) |
---|
2373 | S + ZRNEB(JL) * ZRE1(JL) |
---|
2374 | C |
---|
2375 | ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL) |
---|
2376 | S + PTRA1(JL,JKM1) * (1.-ZRNEB(JL)) |
---|
2377 | C |
---|
2378 | 345 CONTINUE |
---|
2379 | 346 CONTINUE |
---|
2380 | DO 347 JL = 1, KDLON |
---|
2381 | ZMUE = (1.-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66 |
---|
2382 | PRMUE(JL,1)=1./ZMUE |
---|
2383 | 347 CONTINUE |
---|
2384 | C |
---|
2385 | C |
---|
2386 | C ------------------------------------------------------------------ |
---|
2387 | C |
---|
2388 | C* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL |
---|
2389 | C ------------------------------------------------- |
---|
2390 | C |
---|
2391 | 350 CONTINUE |
---|
2392 | C |
---|
2393 | IF (KNU.EQ.1) THEN |
---|
2394 | JAJ = 2 |
---|
2395 | DO 351 JL = 1, KDLON |
---|
2396 | PRJ(JL,JAJ,KFLEV+1) = 1. |
---|
2397 | PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1) |
---|
2398 | 351 CONTINUE |
---|
2399 | C |
---|
2400 | DO 353 JK = 1 , KFLEV |
---|
2401 | JKL = KFLEV+1 - JK |
---|
2402 | JKLP1 = JKL + 1 |
---|
2403 | DO 352 JL = 1, KDLON |
---|
2404 | ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL) |
---|
2405 | PRJ(JL,JAJ,JKL) = ZRE11 |
---|
2406 | PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL) |
---|
2407 | 352 CONTINUE |
---|
2408 | 353 CONTINUE |
---|
2409 | 354 CONTINUE |
---|
2410 | C |
---|
2411 | ELSE |
---|
2412 | C |
---|
2413 | DO 358 JAJ = 1 , 2 |
---|
2414 | DO 355 JL = 1, KDLON |
---|
2415 | PRJ(JL,JAJ,KFLEV+1) = 1. |
---|
2416 | PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1) |
---|
2417 | 355 CONTINUE |
---|
2418 | C |
---|
2419 | DO 357 JK = 1 , KFLEV |
---|
2420 | JKL = KFLEV+1 - JK |
---|
2421 | JKLP1 = JKL + 1 |
---|
2422 | DO 356 JL = 1, KDLON |
---|
2423 | ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL) |
---|
2424 | PRJ(JL,JAJ,JKL) = ZRE11 |
---|
2425 | PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL) |
---|
2426 | 356 CONTINUE |
---|
2427 | 357 CONTINUE |
---|
2428 | 358 CONTINUE |
---|
2429 | C |
---|
2430 | END IF |
---|
2431 | C |
---|
2432 | C ------------------------------------------------------------------ |
---|
2433 | C |
---|
2434 | RETURN |
---|
2435 | END |
---|
2436 | SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW, |
---|
2437 | S PRE1,PRE2,PTR1,PTR2) |
---|
2438 | USE dimphy |
---|
2439 | IMPLICIT none |
---|
2440 | cym#include "dimensions.h" |
---|
2441 | cym#include "dimphy.h" |
---|
2442 | cym#include "raddim.h" |
---|
2443 | C |
---|
2444 | C ------------------------------------------------------------------ |
---|
2445 | C PURPOSE. |
---|
2446 | C -------- |
---|
2447 | C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY |
---|
2448 | C LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION. |
---|
2449 | C |
---|
2450 | C METHOD. |
---|
2451 | C ------- |
---|
2452 | C |
---|
2453 | C STANDARD DELTA-EDDINGTON LAYER CALCULATIONS. |
---|
2454 | C |
---|
2455 | C REFERENCE. |
---|
2456 | C ---------- |
---|
2457 | C |
---|
2458 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
2459 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
2460 | C |
---|
2461 | C AUTHOR. |
---|
2462 | C ------- |
---|
2463 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
2464 | C |
---|
2465 | C MODIFICATIONS. |
---|
2466 | C -------------- |
---|
2467 | C ORIGINAL : 88-12-15 |
---|
2468 | C ------------------------------------------------------------------ |
---|
2469 | C* ARGUMENTS: |
---|
2470 | C |
---|
2471 | REAL*8 PGG(KDLON) ! ASSYMETRY FACTOR |
---|
2472 | REAL*8 PREF(KDLON) ! REFLECTIVITY OF THE UNDERLYING LAYER |
---|
2473 | REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE |
---|
2474 | REAL*8 PTO1(KDLON) ! OPTICAL THICKNESS |
---|
2475 | REAL*8 PW(KDLON) ! SINGLE SCATTERING ALBEDO |
---|
2476 | REAL*8 PRE1(KDLON) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION) |
---|
2477 | REAL*8 PRE2(KDLON) ! LAYER REFLECTIVITY |
---|
2478 | REAL*8 PTR1(KDLON) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION) |
---|
2479 | REAL*8 PTR2(KDLON) ! LAYER TRANSMISSIVITY |
---|
2480 | C |
---|
2481 | C* LOCAL VARIABLES: |
---|
2482 | C |
---|
2483 | INTEGER jl |
---|
2484 | REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM |
---|
2485 | REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG |
---|
2486 | REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B |
---|
2487 | REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23 |
---|
2488 | REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A |
---|
2489 | REAL*8 ZRI0B, ZRI1B |
---|
2490 | REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B |
---|
2491 | REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D |
---|
2492 | C ------------------------------------------------------------------ |
---|
2493 | C |
---|
2494 | C* 1. DELTA-EDDINGTON CALCULATIONS |
---|
2495 | C |
---|
2496 | 100 CONTINUE |
---|
2497 | C |
---|
2498 | DO 131 JL = 1, KDLON |
---|
2499 | C |
---|
2500 | C* 1.1 SET UP THE DELTA-MODIFIED PARAMETERS |
---|
2501 | C |
---|
2502 | 110 CONTINUE |
---|
2503 | C |
---|
2504 | ZFF = PGG(JL)*PGG(JL) |
---|
2505 | ZGP = PGG(JL)/(1.+PGG(JL)) |
---|
2506 | ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL) |
---|
2507 | ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF) |
---|
2508 | ZDT = 2./3. |
---|
2509 | ZX1 = 1.-ZWCP*ZGP |
---|
2510 | ZWM = 1.-ZWCP |
---|
2511 | ZRM2 = PRMUZ(JL) * PRMUZ(JL) |
---|
2512 | ZRK = SQRT(3.*ZWM*ZX1) |
---|
2513 | ZX2 = 4.*(1.-ZRK*ZRK*ZRM2) |
---|
2514 | ZRP=ZRK/ZX1 |
---|
2515 | ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2 |
---|
2516 | ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2 |
---|
2517 | CMAF ZARG=MIN(ZTOP/PRMUZ(JL),200.) |
---|
2518 | ZARG=MIN(ZTOP/PRMUZ(JL),2.0d+2) |
---|
2519 | ZEXMU0=EXP(-ZARG) |
---|
2520 | CMAF ZARG2=MIN(ZRK*ZTOP,200.) |
---|
2521 | ZARG2=MIN(ZRK*ZTOP,2.0d+2) |
---|
2522 | ZEXKP=EXP(ZARG2) |
---|
2523 | ZEXKM = 1./ZEXKP |
---|
2524 | ZXP2P = 1.+ZDT*ZRP |
---|
2525 | ZXM2P = 1.-ZDT*ZRP |
---|
2526 | ZAP2B = ZALPHA+ZDT*ZBETA |
---|
2527 | ZAM2B = ZALPHA-ZDT*ZBETA |
---|
2528 | C |
---|
2529 | C* 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER |
---|
2530 | C |
---|
2531 | 120 CONTINUE |
---|
2532 | C |
---|
2533 | ZA11 = ZXP2P |
---|
2534 | ZA12 = ZXM2P |
---|
2535 | ZA13 = ZAP2B |
---|
2536 | ZA22 = ZXP2P*ZEXKP |
---|
2537 | ZA21 = ZXM2P*ZEXKM |
---|
2538 | ZA23 = ZAM2B*ZEXMU0 |
---|
2539 | ZDENA = ZA11 * ZA22 - ZA21 * ZA12 |
---|
2540 | ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA |
---|
2541 | ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA |
---|
2542 | ZRI0A = ZC1A+ZC2A-ZALPHA |
---|
2543 | ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA |
---|
2544 | PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL) |
---|
2545 | ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0 |
---|
2546 | ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0 |
---|
2547 | PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL) |
---|
2548 | C |
---|
2549 | C* 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER |
---|
2550 | C |
---|
2551 | 130 CONTINUE |
---|
2552 | C |
---|
2553 | ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM |
---|
2554 | ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP |
---|
2555 | ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) ) |
---|
2556 | ZDENB = ZA11 * ZB22 - ZB21 * ZA12 |
---|
2557 | ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB |
---|
2558 | ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB |
---|
2559 | ZRI0C = ZC1B+ZC2B-ZALPHA |
---|
2560 | ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA |
---|
2561 | PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL) |
---|
2562 | ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0 |
---|
2563 | ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0 |
---|
2564 | PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL) |
---|
2565 | C |
---|
2566 | 131 CONTINUE |
---|
2567 | RETURN |
---|
2568 | END |
---|
2569 | SUBROUTINE SWTT (KNU,KA,PU,PTR) |
---|
2570 | USE dimphy |
---|
2571 | IMPLICIT none |
---|
2572 | cym#include "dimensions.h" |
---|
2573 | cym#include "dimphy.h" |
---|
2574 | cym#include "raddim.h" |
---|
2575 | C |
---|
2576 | C----------------------------------------------------------------------- |
---|
2577 | C PURPOSE. |
---|
2578 | C -------- |
---|
2579 | C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
---|
2580 | C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
---|
2581 | C INTERVALS. |
---|
2582 | C |
---|
2583 | C METHOD. |
---|
2584 | C ------- |
---|
2585 | C |
---|
2586 | C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
---|
2587 | C AND HORNER'S ALGORITHM. |
---|
2588 | C |
---|
2589 | C REFERENCE. |
---|
2590 | C ---------- |
---|
2591 | C |
---|
2592 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
2593 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
2594 | C |
---|
2595 | C AUTHOR. |
---|
2596 | C ------- |
---|
2597 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
2598 | C |
---|
2599 | C MODIFICATIONS. |
---|
2600 | C -------------- |
---|
2601 | C ORIGINAL : 88-12-15 |
---|
2602 | C----------------------------------------------------------------------- |
---|
2603 | C |
---|
2604 | C* ARGUMENTS |
---|
2605 | C |
---|
2606 | INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
---|
2607 | INTEGER KA ! INDEX OF THE ABSORBER |
---|
2608 | REAL*8 PU(KDLON) ! ABSORBER AMOUNT |
---|
2609 | C |
---|
2610 | REAL*8 PTR(KDLON) ! TRANSMISSION FUNCTION |
---|
2611 | C |
---|
2612 | C* LOCAL VARIABLES: |
---|
2613 | C |
---|
2614 | REAL*8 ZR1(KDLON), ZR2(KDLON) |
---|
2615 | INTEGER jl, i,j |
---|
2616 | C |
---|
2617 | C* Prescribed Data: |
---|
2618 | C |
---|
2619 | REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) |
---|
2620 | SAVE APAD, BPAD, D |
---|
2621 | c$OMP THREADPRIVATE(APAD, BPAD, D) |
---|
2622 | DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
---|
2623 | S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
---|
2624 | S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
---|
2625 | S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
---|
2626 | S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
---|
2627 | S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
---|
2628 | S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
---|
2629 | S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
---|
2630 | DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
---|
2631 | S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
---|
2632 | S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
---|
2633 | S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
---|
2634 | S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
---|
2635 | S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
---|
2636 | S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
---|
2637 | S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
---|
2638 | C |
---|
2639 | DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
---|
2640 | S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
---|
2641 | S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
---|
2642 | S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
---|
2643 | S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
---|
2644 | S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
---|
2645 | S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
---|
2646 | S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
---|
2647 | DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
---|
2648 | S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
---|
2649 | S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
---|
2650 | S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
---|
2651 | S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
---|
2652 | S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
---|
2653 | S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
---|
2654 | S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
---|
2655 | c |
---|
2656 | DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
---|
2657 | DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
---|
2658 | C |
---|
2659 | C----------------------------------------------------------------------- |
---|
2660 | C |
---|
2661 | C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
---|
2662 | C |
---|
2663 | 100 CONTINUE |
---|
2664 | C |
---|
2665 | DO 201 JL = 1, KDLON |
---|
2666 | ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL) |
---|
2667 | S * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL) |
---|
2668 | S * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL) |
---|
2669 | S * ( APAD(KNU,KA,7) )))))) |
---|
2670 | C |
---|
2671 | ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL) |
---|
2672 | S * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL) |
---|
2673 | S * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL) |
---|
2674 | S * ( BPAD(KNU,KA,7) )))))) |
---|
2675 | C |
---|
2676 | C |
---|
2677 | C* 2. ADD THE BACKGROUND TRANSMISSION |
---|
2678 | C |
---|
2679 | 200 CONTINUE |
---|
2680 | C |
---|
2681 | C |
---|
2682 | PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA) |
---|
2683 | 201 CONTINUE |
---|
2684 | C |
---|
2685 | RETURN |
---|
2686 | END |
---|
2687 | SUBROUTINE SWTT1(KNU,KABS,KIND, PU, PTR) |
---|
2688 | USE dimphy |
---|
2689 | IMPLICIT none |
---|
2690 | cym#include "dimensions.h" |
---|
2691 | cym#include "dimphy.h" |
---|
2692 | cym#include "raddim.h" |
---|
2693 | C |
---|
2694 | C----------------------------------------------------------------------- |
---|
2695 | C PURPOSE. |
---|
2696 | C -------- |
---|
2697 | C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
---|
2698 | C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
---|
2699 | C INTERVALS. |
---|
2700 | C |
---|
2701 | C METHOD. |
---|
2702 | C ------- |
---|
2703 | C |
---|
2704 | C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
---|
2705 | C AND HORNER'S ALGORITHM. |
---|
2706 | C |
---|
2707 | C REFERENCE. |
---|
2708 | C ---------- |
---|
2709 | C |
---|
2710 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
2711 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
2712 | C |
---|
2713 | C AUTHOR. |
---|
2714 | C ------- |
---|
2715 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
2716 | C |
---|
2717 | C MODIFICATIONS. |
---|
2718 | C -------------- |
---|
2719 | C ORIGINAL : 95-01-20 |
---|
2720 | C----------------------------------------------------------------------- |
---|
2721 | C* ARGUMENTS: |
---|
2722 | C |
---|
2723 | INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
---|
2724 | INTEGER KABS ! NUMBER OF ABSORBERS |
---|
2725 | INTEGER KIND(KABS) ! INDICES OF THE ABSORBERS |
---|
2726 | REAL*8 PU(KDLON,KABS) ! ABSORBER AMOUNT |
---|
2727 | C |
---|
2728 | REAL*8 PTR(KDLON,KABS) ! TRANSMISSION FUNCTION |
---|
2729 | C |
---|
2730 | C* LOCAL VARIABLES: |
---|
2731 | C |
---|
2732 | REAL*8 ZR1(KDLON) |
---|
2733 | REAL*8 ZR2(KDLON) |
---|
2734 | REAL*8 ZU(KDLON) |
---|
2735 | INTEGER jl, ja, i, j, ia |
---|
2736 | C |
---|
2737 | C* Prescribed Data: |
---|
2738 | C |
---|
2739 | REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) |
---|
2740 | SAVE APAD, BPAD, D |
---|
2741 | c$OMP THREADPRIVATE(APAD, BPAD, D) |
---|
2742 | DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
---|
2743 | S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
---|
2744 | S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
---|
2745 | S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
---|
2746 | S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
---|
2747 | S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
---|
2748 | S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
---|
2749 | S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
---|
2750 | DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
---|
2751 | S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
---|
2752 | S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
---|
2753 | S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
---|
2754 | S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
---|
2755 | S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
---|
2756 | S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
---|
2757 | S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
---|
2758 | C |
---|
2759 | DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
---|
2760 | S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
---|
2761 | S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
---|
2762 | S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
---|
2763 | S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
---|
2764 | S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
---|
2765 | S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
---|
2766 | S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
---|
2767 | DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
---|
2768 | S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
---|
2769 | S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
---|
2770 | S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
---|
2771 | S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
---|
2772 | S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
---|
2773 | S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
---|
2774 | S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
---|
2775 | c |
---|
2776 | DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
---|
2777 | DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
---|
2778 | C----------------------------------------------------------------------- |
---|
2779 | C |
---|
2780 | C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
---|
2781 | C |
---|
2782 | 100 CONTINUE |
---|
2783 | C |
---|
2784 | DO 202 JA = 1,KABS |
---|
2785 | IA=KIND(JA) |
---|
2786 | DO 201 JL = 1, KDLON |
---|
2787 | ZU(JL) = PU(JL,JA) |
---|
2788 | ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL) |
---|
2789 | S * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL) |
---|
2790 | S * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL) |
---|
2791 | S * ( APAD(KNU,IA,7) )))))) |
---|
2792 | C |
---|
2793 | ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL) |
---|
2794 | S * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL) |
---|
2795 | S * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL) |
---|
2796 | S * ( BPAD(KNU,IA,7) )))))) |
---|
2797 | C |
---|
2798 | C |
---|
2799 | C* 2. ADD THE BACKGROUND TRANSMISSION |
---|
2800 | C |
---|
2801 | 200 CONTINUE |
---|
2802 | C |
---|
2803 | PTR(JL,JA) = (ZR1(JL)/ZR2(JL)) * (1.-D(KNU,IA)) + D(KNU,IA) |
---|
2804 | 201 CONTINUE |
---|
2805 | 202 CONTINUE |
---|
2806 | C |
---|
2807 | RETURN |
---|
2808 | END |
---|
2809 | cIM ctes ds clesphys.h SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12, |
---|
2810 | SUBROUTINE LW( |
---|
2811 | . PPMB, PDP, |
---|
2812 | . PPSOL,PDT0,PEMIS, |
---|
2813 | . PTL, PTAVE, PWV, POZON, PAER, |
---|
2814 | . PCLDLD,PCLDLU, |
---|
2815 | . PVIEW, |
---|
2816 | . PCOLR, PCOLR0, |
---|
2817 | . PTOPLW,PSOLLW,PTOPLW0,PSOLLW0, |
---|
2818 | . psollwdown, |
---|
2819 | cIM . psollwdown,psollwdownclr, |
---|
2820 | cIM . ptoplwdown,ptoplwdownclr) |
---|
2821 | . plwup, plwdn, plwup0, plwdn0) |
---|
2822 | USE dimphy |
---|
2823 | IMPLICIT none |
---|
2824 | cym#include "dimensions.h" |
---|
2825 | cym#include "dimphy.h" |
---|
2826 | cym#include "raddim.h" |
---|
2827 | #include "raddimlw.h" |
---|
2828 | #include "YOMCST.h" |
---|
2829 | C |
---|
2830 | C----------------------------------------------------------------------- |
---|
2831 | C METHOD. |
---|
2832 | C ------- |
---|
2833 | C |
---|
2834 | C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF |
---|
2835 | C ABSORBERS. |
---|
2836 | C 2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE |
---|
2837 | C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS. |
---|
2838 | C 3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON- |
---|
2839 | C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE |
---|
2840 | C BOUNDARIES. |
---|
2841 | C 4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. |
---|
2842 | C 5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES. |
---|
2843 | C |
---|
2844 | C |
---|
2845 | C REFERENCE. |
---|
2846 | C ---------- |
---|
2847 | C |
---|
2848 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
2849 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
2850 | C |
---|
2851 | C AUTHOR. |
---|
2852 | C ------- |
---|
2853 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
2854 | C |
---|
2855 | C MODIFICATIONS. |
---|
2856 | C -------------- |
---|
2857 | C ORIGINAL : 89-07-14 |
---|
2858 | C----------------------------------------------------------------------- |
---|
2859 | cIM ctes ds clesphys.h |
---|
2860 | c REAL*8 RCO2 ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97) |
---|
2861 | c REAL*8 RCH4 ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97) |
---|
2862 | c REAL*8 RN2O ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97) |
---|
2863 | c REAL*8 RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97) |
---|
2864 | c REAL*8 RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97) |
---|
2865 | #include "clesphys.h" |
---|
2866 | REAL*8 PCLDLD(KDLON,KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER |
---|
2867 | REAL*8 PCLDLU(KDLON,KFLEV) ! UPWARD EFFECTIVE CLOUD COVER |
---|
2868 | REAL*8 PDP(KDLON,KFLEV) ! LAYER PRESSURE THICKNESS (Pa) |
---|
2869 | REAL*8 PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K) |
---|
2870 | REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
---|
2871 | REAL*8 PPMB(KDLON,KFLEV+1) ! HALF LEVEL PRESSURE (mb) |
---|
2872 | REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (Pa) |
---|
2873 | REAL*8 POZON(KDLON,KFLEV) ! O3 CONCENTRATION (kg/kg) |
---|
2874 | REAL*8 PTL(KDLON,KFLEV+1) ! HALF LEVEL TEMPERATURE (K) |
---|
2875 | REAL*8 PAER(KDLON,KFLEV,5) ! OPTICAL THICKNESS OF THE AEROSOLS |
---|
2876 | REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K) |
---|
2877 | REAL*8 PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE |
---|
2878 | REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (kg/kg) |
---|
2879 | C |
---|
2880 | REAL*8 PCOLR(KDLON,KFLEV) ! LONG-WAVE TENDENCY (K/day) |
---|
2881 | REAL*8 PCOLR0(KDLON,KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky |
---|
2882 | REAL*8 PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A. |
---|
2883 | REAL*8 PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE |
---|
2884 | REAL*8 PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY) |
---|
2885 | REAL*8 PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY) |
---|
2886 | c Rajout LF |
---|
2887 | real*8 psollwdown(kdlon) ! LONGWAVE downwards flux at surface |
---|
2888 | c Rajout IM |
---|
2889 | cIM real*8 psollwdownclr(kdlon) ! LONGWAVE CS downwards flux at surface |
---|
2890 | cIM real*8 ptoplwdown(kdlon) ! LONGWAVE downwards flux at T.O.A. |
---|
2891 | cIM real*8 ptoplwdownclr(kdlon) ! LONGWAVE CS downwards flux at T.O.A. |
---|
2892 | cIM |
---|
2893 | REAL*8 plwup(KDLON,KFLEV+1) ! LW up total sky |
---|
2894 | REAL*8 plwup0(KDLON,KFLEV+1) ! LW up clear sky |
---|
2895 | REAL*8 plwdn(KDLON,KFLEV+1) ! LW down total sky |
---|
2896 | REAL*8 plwdn0(KDLON,KFLEV+1) ! LW down clear sky |
---|
2897 | C------------------------------------------------------------------------- |
---|
2898 | REAL*8 ZABCU(KDLON,NUA,3*KFLEV+1) |
---|
2899 | REAL*8 ZOZ(KDLON,KFLEV) |
---|
2900 | c |
---|
2901 | cym REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down) |
---|
2902 | cym REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
---|
2903 | cym REAL*8 ZBINT(KDLON,KFLEV+1) ! Intermediate variable |
---|
2904 | cym REAL*8 ZBSUI(KDLON) ! Intermediate variable |
---|
2905 | cym REAL*8,ZCTS(KDLON,KFLEV) ! Intermediate variable |
---|
2906 | cym REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1) ! Intermediate variable |
---|
2907 | cym SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB |
---|
2908 | REAL*8,allocatable,save :: ZFLUX(:,:,:) ! RADIATIVE FLUXES (1:up; 2:down) |
---|
2909 | REAL*8,allocatable,save :: ZFLUC(:,:,:) ! CLEAR-SKY RADIATIVE FLUXES |
---|
2910 | REAL*8,allocatable,save :: ZBINT(:,:) ! Intermediate variable |
---|
2911 | REAL*8,allocatable,save :: ZBSUI(:) ! Intermediate variable |
---|
2912 | REAL*8,allocatable,save :: ZCTS(:,:) ! Intermediate variable |
---|
2913 | REAL*8,allocatable,save :: ZCNTRB(:,:,:) ! Intermediate variable |
---|
2914 | c$OMP THREADPRIVATE(ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB) |
---|
2915 | c |
---|
2916 | INTEGER ilim, i, k, kpl1 |
---|
2917 | C |
---|
2918 | INTEGER lw0pas ! Every lw0pas steps, clear-sky is done |
---|
2919 | PARAMETER (lw0pas=1) |
---|
2920 | INTEGER lwpas ! Every lwpas steps, cloudy-sky is done |
---|
2921 | PARAMETER (lwpas=1) |
---|
2922 | c |
---|
2923 | INTEGER itaplw0, itaplw |
---|
2924 | LOGICAL appel1er |
---|
2925 | SAVE appel1er, itaplw0, itaplw |
---|
2926 | c$OMP THREADPRIVATE(appel1er, itaplw0, itaplw) |
---|
2927 | DATA appel1er /.TRUE./ |
---|
2928 | DATA itaplw0,itaplw /0,0/ |
---|
2929 | |
---|
2930 | C ------------------------------------------------------------------ |
---|
2931 | IF (appel1er) THEN |
---|
2932 | PRINT*, "LW clear-sky calling frequency: ", lw0pas |
---|
2933 | PRINT*, "LW cloudy-sky calling frequency: ", lwpas |
---|
2934 | PRINT*, " In general, they should be 1" |
---|
2935 | cym |
---|
2936 | allocate(ZFLUX(KDLON,2,KFLEV+1) ) |
---|
2937 | allocate(ZFLUC(KDLON,2,KFLEV+1) ) |
---|
2938 | allocate(ZBINT(KDLON,KFLEV+1)) |
---|
2939 | allocate(ZBSUI(KDLON)) |
---|
2940 | allocate(ZCTS(KDLON,KFLEV)) |
---|
2941 | allocate(ZCNTRB(KDLON,KFLEV+1,KFLEV+1)) |
---|
2942 | appel1er=.FALSE. |
---|
2943 | ENDIF |
---|
2944 | C |
---|
2945 | IF (MOD(itaplw0,lw0pas).EQ.0) THEN |
---|
2946 | DO k = 1, KFLEV ! convertir ozone de kg/kg en pa/pa |
---|
2947 | DO i = 1, KDLON |
---|
2948 | c convertir ozone de kg/kg en pa (modif MPL 100505) |
---|
2949 | ZOZ(i,k) = POZON(i,k)*PDP(i,k) * RMD/RMO3 |
---|
2950 | c print *,'LW: ZOZ*10**6=',ZOZ(i,k)*1000000. |
---|
2951 | ENDDO |
---|
2952 | ENDDO |
---|
2953 | cIM ctes ds clesphys.h CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12, |
---|
2954 | CALL LWU( |
---|
2955 | S PAER,PDP,PPMB,PPSOL,ZOZ,PTAVE,PVIEW,PWV,ZABCU) |
---|
2956 | CALL LWBV(ILIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,ZABCU, |
---|
2957 | S ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB) |
---|
2958 | itaplw0 = 0 |
---|
2959 | ENDIF |
---|
2960 | itaplw0 = itaplw0 + 1 |
---|
2961 | C |
---|
2962 | IF (MOD(itaplw,lwpas).EQ.0) THEN |
---|
2963 | CALL LWC(ILIM,PCLDLD,PCLDLU,PEMIS, |
---|
2964 | S ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB, |
---|
2965 | S ZFLUX) |
---|
2966 | itaplw = 0 |
---|
2967 | ENDIF |
---|
2968 | itaplw = itaplw + 1 |
---|
2969 | C |
---|
2970 | DO k = 1, KFLEV |
---|
2971 | kpl1 = k+1 |
---|
2972 | DO i = 1, KDLON |
---|
2973 | PCOLR(i,k) = ZFLUX(i,1,kpl1)+ZFLUX(i,2,kpl1) |
---|
2974 | . - ZFLUX(i,1,k)- ZFLUX(i,2,k) |
---|
2975 | PCOLR(i,k) = PCOLR(i,k) * RDAY*RG/RCPD / PDP(i,k) |
---|
2976 | PCOLR0(i,k) = ZFLUC(i,1,kpl1)+ZFLUC(i,2,kpl1) |
---|
2977 | . - ZFLUC(i,1,k)- ZFLUC(i,2,k) |
---|
2978 | PCOLR0(i,k) = PCOLR0(i,k) * RDAY*RG/RCPD / PDP(i,k) |
---|
2979 | ENDDO |
---|
2980 | ENDDO |
---|
2981 | DO i = 1, KDLON |
---|
2982 | PSOLLW(i) = -ZFLUX(i,1,1)-ZFLUX(i,2,1) |
---|
2983 | PTOPLW(i) = ZFLUX(i,1,KFLEV+1) + ZFLUX(i,2,KFLEV+1) |
---|
2984 | c |
---|
2985 | PSOLLW0(i) = -ZFLUC(i,1,1)-ZFLUC(i,2,1) |
---|
2986 | PTOPLW0(i) = ZFLUC(i,1,KFLEV+1) + ZFLUC(i,2,KFLEV+1) |
---|
2987 | psollwdown(i) = -ZFLUX(i,2,1) |
---|
2988 | c |
---|
2989 | cIM attention aux signes !; LWtop >0, LWdn < 0 |
---|
2990 | DO k = 1, KFLEV+1 |
---|
2991 | plwup(i,k) = ZFLUX(i,1,k) |
---|
2992 | plwup0(i,k) = ZFLUC(i,1,k) |
---|
2993 | plwdn(i,k) = ZFLUX(i,2,k) |
---|
2994 | plwdn0(i,k) = ZFLUC(i,2,k) |
---|
2995 | ENDDO |
---|
2996 | ENDDO |
---|
2997 | C ------------------------------------------------------------------ |
---|
2998 | RETURN |
---|
2999 | END |
---|
3000 | cIM ctes ds clesphys.h SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12, |
---|
3001 | SUBROUTINE LWU( |
---|
3002 | S PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV, |
---|
3003 | S PABCU) |
---|
3004 | USE dimphy |
---|
3005 | IMPLICIT none |
---|
3006 | cym#include "dimensions.h" |
---|
3007 | cym#include "dimphy.h" |
---|
3008 | cym#include "raddim.h" |
---|
3009 | #include "raddimlw.h" |
---|
3010 | #include "YOMCST.h" |
---|
3011 | #include "radepsi.h" |
---|
3012 | #include "radopt.h" |
---|
3013 | C |
---|
3014 | C PURPOSE. |
---|
3015 | C -------- |
---|
3016 | C COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND |
---|
3017 | C TEMPERATURE EFFECTS |
---|
3018 | C |
---|
3019 | C METHOD. |
---|
3020 | C ------- |
---|
3021 | C |
---|
3022 | C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF |
---|
3023 | C ABSORBERS. |
---|
3024 | C |
---|
3025 | C |
---|
3026 | C REFERENCE. |
---|
3027 | C ---------- |
---|
3028 | C |
---|
3029 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
3030 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
3031 | C |
---|
3032 | C AUTHOR. |
---|
3033 | C ------- |
---|
3034 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
3035 | C |
---|
3036 | C MODIFICATIONS. |
---|
3037 | C -------------- |
---|
3038 | C ORIGINAL : 89-07-14 |
---|
3039 | C Voigt lines (loop 404 modified) - JJM & PhD - 01/96 |
---|
3040 | C----------------------------------------------------------------------- |
---|
3041 | C* ARGUMENTS: |
---|
3042 | cIM ctes ds clesphys.h |
---|
3043 | c REAL*8 RCO2 |
---|
3044 | c REAL*8 RCH4, RN2O, RCFC11, RCFC12 |
---|
3045 | #include "clesphys.h" |
---|
3046 | REAL*8 PAER(KDLON,KFLEV,5) |
---|
3047 | REAL*8 PDP(KDLON,KFLEV) |
---|
3048 | REAL*8 PPMB(KDLON,KFLEV+1) |
---|
3049 | REAL*8 PPSOL(KDLON) |
---|
3050 | REAL*8 POZ(KDLON,KFLEV) |
---|
3051 | REAL*8 PTAVE(KDLON,KFLEV) |
---|
3052 | REAL*8 PVIEW(KDLON) |
---|
3053 | REAL*8 PWV(KDLON,KFLEV) |
---|
3054 | C |
---|
3055 | REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS |
---|
3056 | C |
---|
3057 | C----------------------------------------------------------------------- |
---|
3058 | C* LOCAL VARIABLES: |
---|
3059 | REAL*8 ZABLY(KDLON,NUA,3*KFLEV+1) |
---|
3060 | REAL*8 ZDUC(KDLON,3*KFLEV+1) |
---|
3061 | REAL*8 ZPHIO(KDLON) |
---|
3062 | REAL*8 ZPSC2(KDLON) |
---|
3063 | REAL*8 ZPSC3(KDLON) |
---|
3064 | REAL*8 ZPSH1(KDLON) |
---|
3065 | REAL*8 ZPSH2(KDLON) |
---|
3066 | REAL*8 ZPSH3(KDLON) |
---|
3067 | REAL*8 ZPSH4(KDLON) |
---|
3068 | REAL*8 ZPSH5(KDLON) |
---|
3069 | REAL*8 ZPSH6(KDLON) |
---|
3070 | REAL*8 ZPSIO(KDLON) |
---|
3071 | REAL*8 ZTCON(KDLON) |
---|
3072 | REAL*8 ZPHM6(KDLON) |
---|
3073 | REAL*8 ZPSM6(KDLON) |
---|
3074 | REAL*8 ZPHN6(KDLON) |
---|
3075 | REAL*8 ZPSN6(KDLON) |
---|
3076 | REAL*8 ZSSIG(KDLON,3*KFLEV+1) |
---|
3077 | REAL*8 ZTAVI(KDLON) |
---|
3078 | REAL*8 ZUAER(KDLON,Ninter) |
---|
3079 | REAL*8 ZXOZ(KDLON) |
---|
3080 | REAL*8 ZXWV(KDLON) |
---|
3081 | C |
---|
3082 | INTEGER jl, jk, jkj, jkjr, jkjp, ig1 |
---|
3083 | INTEGER jki, jkip1, ja, jj |
---|
3084 | INTEGER jkl, jkp1, jkk, jkjpn |
---|
3085 | INTEGER jae1, jae2, jae3, jae, jjpn |
---|
3086 | INTEGER ir, jc, jcp1 |
---|
3087 | REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup |
---|
3088 | REAL*8 zfppw, ztx, ztx2, zzably |
---|
3089 | REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3 |
---|
3090 | REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6 |
---|
3091 | REAL*8 zcac8, zcbc8 |
---|
3092 | REAL*8 zalup, zdiff |
---|
3093 | c |
---|
3094 | REAL*8 PVGCO2, PVGH2O, PVGO3 |
---|
3095 | C |
---|
3096 | REAL*8 R10E ! DECIMAL/NATURAL LOG.FACTOR |
---|
3097 | PARAMETER (R10E=0.4342945) |
---|
3098 | c |
---|
3099 | c Used Data Block: |
---|
3100 | c |
---|
3101 | REAL*8 TREF |
---|
3102 | SAVE TREF |
---|
3103 | c$OMP THREADPRIVATE(TREF) |
---|
3104 | REAL*8 RT1(2) |
---|
3105 | SAVE RT1 |
---|
3106 | c$OMP THREADPRIVATE(RT1) |
---|
3107 | REAL*8 RAER(5,5) |
---|
3108 | SAVE RAER |
---|
3109 | c$OMP THREADPRIVATE(RAER) |
---|
3110 | REAL*8 AT(8,3), BT(8,3) |
---|
3111 | SAVE AT, BT |
---|
3112 | c$OMP THREADPRIVATE(AT, BT) |
---|
3113 | REAL*8 OCT(4) |
---|
3114 | SAVE OCT |
---|
3115 | c$OMP THREADPRIVATE(OCT) |
---|
3116 | DATA TREF /250.0/ |
---|
3117 | DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 / |
---|
3118 | DATA RAER / .038520, .037196, .040532, .054934, .038520 |
---|
3119 | 1 , .12613 , .18313 , .10357 , .064106, .126130 |
---|
3120 | 2 , .012579, .013649, .018652, .025181, .012579 |
---|
3121 | 3 , .011890, .016142, .021105, .028908, .011890 |
---|
3122 | 4 , .013792, .026810, .052203, .066338, .013792 / |
---|
3123 | DATA (AT(1,IR),IR=1,3) / |
---|
3124 | S 0.298199E-02,-.394023E-03,0.319566E-04 / |
---|
3125 | DATA (BT(1,IR),IR=1,3) / |
---|
3126 | S-0.106432E-04,0.660324E-06,0.174356E-06 / |
---|
3127 | DATA (AT(2,IR),IR=1,3) / |
---|
3128 | S 0.143676E-01,0.366501E-02,-.160822E-02 / |
---|
3129 | DATA (BT(2,IR),IR=1,3) / |
---|
3130 | S-0.553979E-04,-.101701E-04,0.920868E-05 / |
---|
3131 | DATA (AT(3,IR),IR=1,3) / |
---|
3132 | S 0.197861E-01,0.315541E-02,-.174547E-02 / |
---|
3133 | DATA (BT(3,IR),IR=1,3) / |
---|
3134 | S-0.877012E-04,0.513302E-04,0.523138E-06 / |
---|
3135 | DATA (AT(4,IR),IR=1,3) / |
---|
3136 | S 0.289560E-01,-.208807E-02,-.121943E-02 / |
---|
3137 | DATA (BT(4,IR),IR=1,3) / |
---|
3138 | S-0.165960E-03,0.157704E-03,-.146427E-04 / |
---|
3139 | DATA (AT(5,IR),IR=1,3) / |
---|
3140 | S 0.103800E-01,0.436296E-02,-.161431E-02 / |
---|
3141 | DATA (BT(5,IR),IR=1,3) / |
---|
3142 | S -.276744E-04,-.327381E-04,0.127646E-04 / |
---|
3143 | DATA (AT(6,IR),IR=1,3) / |
---|
3144 | S 0.868859E-02,-.972752E-03,0.000000E-00 / |
---|
3145 | DATA (BT(6,IR),IR=1,3) / |
---|
3146 | S -.278412E-04,-.713940E-06,0.117469E-05 / |
---|
3147 | DATA (AT(7,IR),IR=1,3) / |
---|
3148 | S 0.250073E-03,0.455875E-03,0.109242E-03 / |
---|
3149 | DATA (BT(7,IR),IR=1,3) / |
---|
3150 | S 0.199846E-05,-.216313E-05,0.175991E-06 / |
---|
3151 | DATA (AT(8,IR),IR=1,3) / |
---|
3152 | S 0.307423E-01,0.110879E-02,-.322172E-03 / |
---|
3153 | DATA (BT(8,IR),IR=1,3) / |
---|
3154 | S-0.108482E-03,0.258096E-05,-.814575E-06 / |
---|
3155 | c |
---|
3156 | DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/ |
---|
3157 | C----------------------------------------------------------------------- |
---|
3158 | c |
---|
3159 | IF (LEVOIGT) THEN |
---|
3160 | PVGCO2= 60. |
---|
3161 | PVGH2O= 30. |
---|
3162 | PVGO3 =400. |
---|
3163 | ELSE |
---|
3164 | PVGCO2= 0. |
---|
3165 | PVGH2O= 0. |
---|
3166 | PVGO3 = 0. |
---|
3167 | ENDIF |
---|
3168 | C |
---|
3169 | C |
---|
3170 | C* 2. PRESSURE OVER GAUSS SUB-LEVELS |
---|
3171 | C ------------------------------ |
---|
3172 | C |
---|
3173 | 200 CONTINUE |
---|
3174 | C |
---|
3175 | DO 201 JL = 1, KDLON |
---|
3176 | ZSSIG(JL, 1 ) = PPMB(JL,1) * 100. |
---|
3177 | 201 CONTINUE |
---|
3178 | C |
---|
3179 | DO 206 JK = 1 , KFLEV |
---|
3180 | JKJ=(JK-1)*NG1P1+1 |
---|
3181 | JKJR = JKJ |
---|
3182 | JKJP = JKJ + NG1P1 |
---|
3183 | DO 203 JL = 1, KDLON |
---|
3184 | ZSSIG(JL,JKJP)=PPMB(JL,JK+1)* 100. |
---|
3185 | 203 CONTINUE |
---|
3186 | DO 205 IG1=1,NG1 |
---|
3187 | JKJ=JKJ+1 |
---|
3188 | DO 204 JL = 1, KDLON |
---|
3189 | ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5 |
---|
3190 | S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5 |
---|
3191 | 204 CONTINUE |
---|
3192 | 205 CONTINUE |
---|
3193 | 206 CONTINUE |
---|
3194 | C |
---|
3195 | C----------------------------------------------------------------------- |
---|
3196 | C |
---|
3197 | C |
---|
3198 | C* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS |
---|
3199 | C -------------------------------------------------- |
---|
3200 | C |
---|
3201 | 400 CONTINUE |
---|
3202 | C |
---|
3203 | DO 402 JKI=1,3*KFLEV |
---|
3204 | JKIP1=JKI+1 |
---|
3205 | DO 401 JL = 1, KDLON |
---|
3206 | ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5 |
---|
3207 | ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1)) |
---|
3208 | S /(10.*RG) |
---|
3209 | 401 CONTINUE |
---|
3210 | 402 CONTINUE |
---|
3211 | C |
---|
3212 | DO 406 JK = 1 , KFLEV |
---|
3213 | JKP1=JK+1 |
---|
3214 | JKL = KFLEV+1 - JK |
---|
3215 | DO 403 JL = 1, KDLON |
---|
3216 | ZXWV(JL) = MAX (PWV(JL,JK) , ZEPSCQ ) |
---|
3217 | ZXOZ(JL) = MAX (POZ(JL,JK) / PDP(JL,JK) , ZEPSCO ) |
---|
3218 | 403 CONTINUE |
---|
3219 | JKJ=(JK-1)*NG1P1+1 |
---|
3220 | JKJPN=JKJ+NG1 |
---|
3221 | DO 405 JKK=JKJ,JKJPN |
---|
3222 | DO 404 JL = 1, KDLON |
---|
3223 | ZDPM = ZABLY(JL,3,JKK) |
---|
3224 | ZUPM = ZABLY(JL,5,JKK) * ZDPM / 101325. |
---|
3225 | ZUPMCO2 = ( ZABLY(JL,5,JKK) + PVGCO2 ) * ZDPM / 101325. |
---|
3226 | ZUPMH2O = ( ZABLY(JL,5,JKK) + PVGH2O ) * ZDPM / 101325. |
---|
3227 | ZUPMO3 = ( ZABLY(JL,5,JKK) + PVGO3 ) * ZDPM / 101325. |
---|
3228 | ZDUC(JL,JKK) = ZDPM |
---|
3229 | ZABLY(JL,12,JKK) = ZXOZ(JL) * ZDPM |
---|
3230 | ZABLY(JL,13,JKK) = ZXOZ(JL) * ZUPMO3 |
---|
3231 | ZU6 = ZXWV(JL) * ZUPM |
---|
3232 | ZFPPW = 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL)) |
---|
3233 | ZABLY(JL,6,JKK) = ZXWV(JL) * ZUPMH2O |
---|
3234 | ZABLY(JL,11,JKK) = ZU6 * ZFPPW |
---|
3235 | ZABLY(JL,10,JKK) = ZU6 * (1.-ZFPPW) |
---|
3236 | ZABLY(JL,9,JKK) = RCO2 * ZUPMCO2 |
---|
3237 | ZABLY(JL,8,JKK) = RCO2 * ZDPM |
---|
3238 | 404 CONTINUE |
---|
3239 | 405 CONTINUE |
---|
3240 | 406 CONTINUE |
---|
3241 | C |
---|
3242 | C----------------------------------------------------------------------- |
---|
3243 | C |
---|
3244 | C |
---|
3245 | C* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE |
---|
3246 | C -------------------------------------------------- |
---|
3247 | C |
---|
3248 | 500 CONTINUE |
---|
3249 | C |
---|
3250 | DO 502 JA = 1, NUA |
---|
3251 | DO 501 JL = 1, KDLON |
---|
3252 | PABCU(JL,JA,3*KFLEV+1) = 0. |
---|
3253 | 501 CONTINUE |
---|
3254 | 502 CONTINUE |
---|
3255 | C |
---|
3256 | DO 529 JK = 1 , KFLEV |
---|
3257 | JJ=(JK-1)*NG1P1+1 |
---|
3258 | JJPN=JJ+NG1 |
---|
3259 | JKL=KFLEV+1-JK |
---|
3260 | C |
---|
3261 | C |
---|
3262 | C* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE |
---|
3263 | C -------------------------------------------------- |
---|
3264 | C |
---|
3265 | 510 CONTINUE |
---|
3266 | C |
---|
3267 | JAE1=3*KFLEV+1-JJ |
---|
3268 | JAE2=3*KFLEV+1-(JJ+1) |
---|
3269 | JAE3=3*KFLEV+1-JJPN |
---|
3270 | DO 512 JAE=1,5 |
---|
3271 | DO 511 JL = 1, KDLON |
---|
3272 | ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL,JKL,1) |
---|
3273 | S +RAER(JAE,2)*PAER(JL,JKL,2)+RAER(JAE,3)*PAER(JL,JKL,3) |
---|
3274 | S +RAER(JAE,4)*PAER(JL,JKL,4)+RAER(JAE,5)*PAER(JL,JKL,5)) |
---|
3275 | S /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3)) |
---|
3276 | 511 CONTINUE |
---|
3277 | 512 CONTINUE |
---|
3278 | C |
---|
3279 | C |
---|
3280 | C |
---|
3281 | C* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS |
---|
3282 | C -------------------------------------------------- |
---|
3283 | C |
---|
3284 | 520 CONTINUE |
---|
3285 | C |
---|
3286 | DO 521 JL = 1, KDLON |
---|
3287 | ZTAVI(JL)=PTAVE(JL,JKL) |
---|
3288 | ZTCON(JL)=EXP(6.08*(296./ZTAVI(JL)-1.)) |
---|
3289 | ZTX=ZTAVI(JL)-TREF |
---|
3290 | ZTX2=ZTX*ZTX |
---|
3291 | ZZABLY = ZABLY(JL,6,JAE1)+ZABLY(JL,6,JAE2)+ZABLY(JL,6,JAE3) |
---|
3292 | CMAF ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.), 6.0) |
---|
3293 | ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.d+0), 6.d+0) |
---|
3294 | ZCAH1=AT(1,1)+ZUP*(AT(1,2)+ZUP*(AT(1,3))) |
---|
3295 | ZCBH1=BT(1,1)+ZUP*(BT(1,2)+ZUP*(BT(1,3))) |
---|
3296 | ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 ) |
---|
3297 | ZCAH2=AT(2,1)+ZUP*(AT(2,2)+ZUP*(AT(2,3))) |
---|
3298 | ZCBH2=BT(2,1)+ZUP*(BT(2,2)+ZUP*(BT(2,3))) |
---|
3299 | ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 ) |
---|
3300 | ZCAH3=AT(3,1)+ZUP*(AT(3,2)+ZUP*(AT(3,3))) |
---|
3301 | ZCBH3=BT(3,1)+ZUP*(BT(3,2)+ZUP*(BT(3,3))) |
---|
3302 | ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 ) |
---|
3303 | ZCAH4=AT(4,1)+ZUP*(AT(4,2)+ZUP*(AT(4,3))) |
---|
3304 | ZCBH4=BT(4,1)+ZUP*(BT(4,2)+ZUP*(BT(4,3))) |
---|
3305 | ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 ) |
---|
3306 | ZCAH5=AT(5,1)+ZUP*(AT(5,2)+ZUP*(AT(5,3))) |
---|
3307 | ZCBH5=BT(5,1)+ZUP*(BT(5,2)+ZUP*(BT(5,3))) |
---|
3308 | ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 ) |
---|
3309 | ZCAH6=AT(6,1)+ZUP*(AT(6,2)+ZUP*(AT(6,3))) |
---|
3310 | ZCBH6=BT(6,1)+ZUP*(BT(6,2)+ZUP*(BT(6,3))) |
---|
3311 | ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 ) |
---|
3312 | ZPHM6(JL)=EXP(-5.81E-4 * ZTX - 1.13E-6 * ZTX2 ) |
---|
3313 | ZPSM6(JL)=EXP(-5.57E-4 * ZTX - 3.30E-6 * ZTX2 ) |
---|
3314 | ZPHN6(JL)=EXP(-3.46E-5 * ZTX + 2.05E-7 * ZTX2 ) |
---|
3315 | ZPSN6(JL)=EXP( 3.70E-3 * ZTX - 2.30E-6 * ZTX2 ) |
---|
3316 | 521 CONTINUE |
---|
3317 | C |
---|
3318 | DO 522 JL = 1, KDLON |
---|
3319 | ZTAVI(JL)=PTAVE(JL,JKL) |
---|
3320 | ZTX=ZTAVI(JL)-TREF |
---|
3321 | ZTX2=ZTX*ZTX |
---|
3322 | ZZABLY = ZABLY(JL,9,JAE1)+ZABLY(JL,9,JAE2)+ZABLY(JL,9,JAE3) |
---|
3323 | ZALUP = R10E * LOG ( ZZABLY ) |
---|
3324 | CMAF ZUP = MAX( 0.0 , 5.0 + 0.5 * ZALUP ) |
---|
3325 | ZUP = MAX( 0.d+0 , 5.0 + 0.5 * ZALUP ) |
---|
3326 | ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP |
---|
3327 | ZCAC8=AT(8,1)+ZUP*(AT(8,2)+ZUP*(AT(8,3))) |
---|
3328 | ZCBC8=BT(8,1)+ZUP*(BT(8,2)+ZUP*(BT(8,3))) |
---|
3329 | ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 ) |
---|
3330 | ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2) |
---|
3331 | ZPSIO(JL) = EXP( 2.* (OCT(3)*ZTX+OCT(4)*ZTX2)) |
---|
3332 | 522 CONTINUE |
---|
3333 | C |
---|
3334 | DO 524 JKK=JJ,JJPN |
---|
3335 | JC=3*KFLEV+1-JKK |
---|
3336 | JCP1=JC+1 |
---|
3337 | DO 523 JL = 1, KDLON |
---|
3338 | ZDIFF = PVIEW(JL) |
---|
3339 | PABCU(JL,10,JC)=PABCU(JL,10,JCP1) |
---|
3340 | S +ZABLY(JL,10,JC) *ZDIFF |
---|
3341 | PABCU(JL,11,JC)=PABCU(JL,11,JCP1) |
---|
3342 | S +ZABLY(JL,11,JC)*ZTCON(JL)*ZDIFF |
---|
3343 | C |
---|
3344 | PABCU(JL,12,JC)=PABCU(JL,12,JCP1) |
---|
3345 | S +ZABLY(JL,12,JC)*ZPHIO(JL)*ZDIFF |
---|
3346 | PABCU(JL,13,JC)=PABCU(JL,13,JCP1) |
---|
3347 | S +ZABLY(JL,13,JC)*ZPSIO(JL)*ZDIFF |
---|
3348 | C |
---|
3349 | PABCU(JL,7,JC)=PABCU(JL,7,JCP1) |
---|
3350 | S +ZABLY(JL,9,JC)*ZPSC2(JL)*ZDIFF |
---|
3351 | PABCU(JL,8,JC)=PABCU(JL,8,JCP1) |
---|
3352 | S +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF |
---|
3353 | PABCU(JL,9,JC)=PABCU(JL,9,JCP1) |
---|
3354 | S +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF |
---|
3355 | C |
---|
3356 | PABCU(JL,1,JC)=PABCU(JL,1,JCP1) |
---|
3357 | S +ZABLY(JL,6,JC)*ZPSH1(JL)*ZDIFF |
---|
3358 | PABCU(JL,2,JC)=PABCU(JL,2,JCP1) |
---|
3359 | S +ZABLY(JL,6,JC)*ZPSH2(JL)*ZDIFF |
---|
3360 | PABCU(JL,3,JC)=PABCU(JL,3,JCP1) |
---|
3361 | S +ZABLY(JL,6,JC)*ZPSH5(JL)*ZDIFF |
---|
3362 | PABCU(JL,4,JC)=PABCU(JL,4,JCP1) |
---|
3363 | S +ZABLY(JL,6,JC)*ZPSH3(JL)*ZDIFF |
---|
3364 | PABCU(JL,5,JC)=PABCU(JL,5,JCP1) |
---|
3365 | S +ZABLY(JL,6,JC)*ZPSH4(JL)*ZDIFF |
---|
3366 | PABCU(JL,6,JC)=PABCU(JL,6,JCP1) |
---|
3367 | S +ZABLY(JL,6,JC)*ZPSH6(JL)*ZDIFF |
---|
3368 | C |
---|
3369 | PABCU(JL,14,JC)=PABCU(JL,14,JCP1) |
---|
3370 | S +ZUAER(JL,1) *ZDUC(JL,JC)*ZDIFF |
---|
3371 | PABCU(JL,15,JC)=PABCU(JL,15,JCP1) |
---|
3372 | S +ZUAER(JL,2) *ZDUC(JL,JC)*ZDIFF |
---|
3373 | PABCU(JL,16,JC)=PABCU(JL,16,JCP1) |
---|
3374 | S +ZUAER(JL,3) *ZDUC(JL,JC)*ZDIFF |
---|
3375 | PABCU(JL,17,JC)=PABCU(JL,17,JCP1) |
---|
3376 | S +ZUAER(JL,4) *ZDUC(JL,JC)*ZDIFF |
---|
3377 | PABCU(JL,18,JC)=PABCU(JL,18,JCP1) |
---|
3378 | S +ZUAER(JL,5) *ZDUC(JL,JC)*ZDIFF |
---|
3379 | C |
---|
3380 | PABCU(JL,19,JC)=PABCU(JL,19,JCP1) |
---|
3381 | S +ZABLY(JL,8,JC)*RCH4/RCO2*ZPHM6(JL)*ZDIFF |
---|
3382 | PABCU(JL,20,JC)=PABCU(JL,20,JCP1) |
---|
3383 | S +ZABLY(JL,9,JC)*RCH4/RCO2*ZPSM6(JL)*ZDIFF |
---|
3384 | PABCU(JL,21,JC)=PABCU(JL,21,JCP1) |
---|
3385 | S +ZABLY(JL,8,JC)*RN2O/RCO2*ZPHN6(JL)*ZDIFF |
---|
3386 | PABCU(JL,22,JC)=PABCU(JL,22,JCP1) |
---|
3387 | S +ZABLY(JL,9,JC)*RN2O/RCO2*ZPSN6(JL)*ZDIFF |
---|
3388 | C |
---|
3389 | PABCU(JL,23,JC)=PABCU(JL,23,JCP1) |
---|
3390 | S +ZABLY(JL,8,JC)*RCFC11/RCO2 *ZDIFF |
---|
3391 | PABCU(JL,24,JC)=PABCU(JL,24,JCP1) |
---|
3392 | S +ZABLY(JL,8,JC)*RCFC12/RCO2 *ZDIFF |
---|
3393 | 523 CONTINUE |
---|
3394 | 524 CONTINUE |
---|
3395 | C |
---|
3396 | 529 CONTINUE |
---|
3397 | C |
---|
3398 | C |
---|
3399 | RETURN |
---|
3400 | END |
---|
3401 | SUBROUTINE LWBV(KLIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,PABCU, |
---|
3402 | S PFLUC,PBINT,PBSUI,PCTS,PCNTRB) |
---|
3403 | USE dimphy |
---|
3404 | IMPLICIT none |
---|
3405 | cym#include "dimensions.h" |
---|
3406 | cym#include "dimphy.h" |
---|
3407 | cym#include "raddim.h" |
---|
3408 | #include "raddimlw.h" |
---|
3409 | #include "YOMCST.h" |
---|
3410 | C |
---|
3411 | C PURPOSE. |
---|
3412 | C -------- |
---|
3413 | C TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE |
---|
3414 | C VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY |
---|
3415 | C SAVING |
---|
3416 | C |
---|
3417 | C METHOD. |
---|
3418 | C ------- |
---|
3419 | C |
---|
3420 | C 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE |
---|
3421 | C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS. |
---|
3422 | C 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON- |
---|
3423 | C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE |
---|
3424 | C BOUNDARIES. |
---|
3425 | C 3. COMPUTES THE CLEAR-SKY COOLING RATES. |
---|
3426 | C |
---|
3427 | C REFERENCE. |
---|
3428 | C ---------- |
---|
3429 | C |
---|
3430 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
3431 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
3432 | C |
---|
3433 | C AUTHOR. |
---|
3434 | C ------- |
---|
3435 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
3436 | C |
---|
3437 | C MODIFICATIONS. |
---|
3438 | C -------------- |
---|
3439 | C ORIGINAL : 89-07-14 |
---|
3440 | C MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE |
---|
3441 | C MEMORY) |
---|
3442 | C----------------------------------------------------------------------- |
---|
3443 | C* ARGUMENTS: |
---|
3444 | INTEGER KLIM |
---|
3445 | C |
---|
3446 | REAL*8 PDP(KDLON,KFLEV) |
---|
3447 | REAL*8 PDT0(KDLON) |
---|
3448 | REAL*8 PEMIS(KDLON) |
---|
3449 | REAL*8 PPMB(KDLON,KFLEV+1) |
---|
3450 | REAL*8 PTL(KDLON,KFLEV+1) |
---|
3451 | REAL*8 PTAVE(KDLON,KFLEV) |
---|
3452 | C |
---|
3453 | REAL*8 PFLUC(KDLON,2,KFLEV+1) |
---|
3454 | C |
---|
3455 | REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) |
---|
3456 | REAL*8 PBINT(KDLON,KFLEV+1) |
---|
3457 | REAL*8 PBSUI(KDLON) |
---|
3458 | REAL*8 PCTS(KDLON,KFLEV) |
---|
3459 | REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) |
---|
3460 | C |
---|
3461 | C------------------------------------------------------------------------- |
---|
3462 | C |
---|
3463 | C* LOCAL VARIABLES: |
---|
3464 | REAL*8 ZB(KDLON,Ninter,KFLEV+1) |
---|
3465 | REAL*8 ZBSUR(KDLON,Ninter) |
---|
3466 | REAL*8 ZBTOP(KDLON,Ninter) |
---|
3467 | REAL*8 ZDBSL(KDLON,Ninter,KFLEV*2) |
---|
3468 | REAL*8 ZGA(KDLON,8,2,KFLEV) |
---|
3469 | REAL*8 ZGB(KDLON,8,2,KFLEV) |
---|
3470 | REAL*8 ZGASUR(KDLON,8,2) |
---|
3471 | REAL*8 ZGBSUR(KDLON,8,2) |
---|
3472 | REAL*8 ZGATOP(KDLON,8,2) |
---|
3473 | REAL*8 ZGBTOP(KDLON,8,2) |
---|
3474 | C |
---|
3475 | INTEGER nuaer, ntraer |
---|
3476 | C ------------------------------------------------------------------ |
---|
3477 | C* COMPUTES PLANCK FUNCTIONS: |
---|
3478 | CALL LWB(PDT0,PTAVE,PTL, |
---|
3479 | S ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL, |
---|
3480 | S ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP) |
---|
3481 | C ------------------------------------------------------------------ |
---|
3482 | C* PERFORMS THE VERTICAL INTEGRATION: |
---|
3483 | NUAER = NUA |
---|
3484 | NTRAER = NTRA |
---|
3485 | CALL LWV(NUAER,NTRAER, KLIM |
---|
3486 | R , PABCU,ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL,PEMIS,PPMB,PTAVE |
---|
3487 | R , ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP |
---|
3488 | S , PCNTRB,PCTS,PFLUC) |
---|
3489 | C ------------------------------------------------------------------ |
---|
3490 | RETURN |
---|
3491 | END |
---|
3492 | SUBROUTINE LWC(KLIM,PCLDLD,PCLDLU,PEMIS,PFLUC, |
---|
3493 | R PBINT,PBSUIN,PCTS,PCNTRB, |
---|
3494 | S PFLUX) |
---|
3495 | USE dimphy |
---|
3496 | IMPLICIT none |
---|
3497 | cym#include "dimensions.h" |
---|
3498 | cym#include "dimphy.h" |
---|
3499 | cym#include "raddim.h" |
---|
3500 | #include "radepsi.h" |
---|
3501 | #include "radopt.h" |
---|
3502 | C |
---|
3503 | C PURPOSE. |
---|
3504 | C -------- |
---|
3505 | C INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR |
---|
3506 | C RADIANCES |
---|
3507 | C |
---|
3508 | C EXPLICIT ARGUMENTS : |
---|
3509 | C -------------------- |
---|
3510 | C ==== INPUTS === |
---|
3511 | C PBINT : (KDLON,0:KFLEV) ; HALF LEVEL PLANCK FUNCTION |
---|
3512 | C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION |
---|
3513 | C PCLDLD : (KDLON,KFLEV) ; DOWNWARD EFFECTIVE CLOUD FRACTION |
---|
3514 | C PCLDLU : (KDLON,KFLEV) ; UPWARD EFFECTIVE CLOUD FRACTION |
---|
3515 | C PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE |
---|
3516 | C PCTS : (KDLON,KFLEV) ; CLEAR-SKY LAYER COOLING-TO-SPACE |
---|
3517 | C PEMIS : (KDLON) ; SURFACE EMISSIVITY |
---|
3518 | C PFLUC |
---|
3519 | C ==== OUTPUTS === |
---|
3520 | C PFLUX(KDLON,2,KFLEV) ; RADIATIVE FLUXES : |
---|
3521 | C 1 ==> UPWARD FLUX TOTAL |
---|
3522 | C 2 ==> DOWNWARD FLUX TOTAL |
---|
3523 | C |
---|
3524 | C METHOD. |
---|
3525 | C ------- |
---|
3526 | C |
---|
3527 | C 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES |
---|
3528 | C 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER |
---|
3529 | C 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED |
---|
3530 | C CLOUDS |
---|
3531 | C |
---|
3532 | C REFERENCE. |
---|
3533 | C ---------- |
---|
3534 | C |
---|
3535 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
3536 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
3537 | C |
---|
3538 | C AUTHOR. |
---|
3539 | C ------- |
---|
3540 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
3541 | C |
---|
3542 | C MODIFICATIONS. |
---|
3543 | C -------------- |
---|
3544 | C ORIGINAL : 89-07-14 |
---|
3545 | C Voigt lines (loop 231 to 233) - JJM & PhD - 01/96 |
---|
3546 | C----------------------------------------------------------------------- |
---|
3547 | C* ARGUMENTS: |
---|
3548 | INTEGER klim |
---|
3549 | REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
---|
3550 | REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION |
---|
3551 | REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
---|
3552 | REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE |
---|
3553 | REAL*8 PCTS(KDLON,KFLEV) ! CLEAR-SKY LAYER COOLING-TO-SPACE |
---|
3554 | c |
---|
3555 | REAL*8 PCLDLD(KDLON,KFLEV) |
---|
3556 | REAL*8 PCLDLU(KDLON,KFLEV) |
---|
3557 | REAL*8 PEMIS(KDLON) |
---|
3558 | C |
---|
3559 | REAL*8 PFLUX(KDLON,2,KFLEV+1) |
---|
3560 | C----------------------------------------------------------------------- |
---|
3561 | C* LOCAL VARIABLES: |
---|
3562 | INTEGER IMX(KDLON), IMXP(KDLON) |
---|
3563 | C |
---|
3564 | REAL*8 ZCLEAR(KDLON),ZCLOUD(KDLON),ZDNF(KDLON,KFLEV+1,KFLEV+1) |
---|
3565 | S , ZFD(KDLON), ZFN10(KDLON), ZFU(KDLON) |
---|
3566 | S , ZUPF(KDLON,KFLEV+1,KFLEV+1) |
---|
3567 | REAL*8 ZCLM(KDLON,KFLEV+1,KFLEV+1) |
---|
3568 | C |
---|
3569 | INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1 |
---|
3570 | INTEGER jk1, jk2, jkc, jkcp1, jcloud |
---|
3571 | INTEGER imxm1, imxp1 |
---|
3572 | REAL*8 zcfrac |
---|
3573 | C ------------------------------------------------------------------ |
---|
3574 | C |
---|
3575 | C* 1. INITIALIZATION |
---|
3576 | C -------------- |
---|
3577 | C |
---|
3578 | 100 CONTINUE |
---|
3579 | C |
---|
3580 | IMAXC = 0 |
---|
3581 | C |
---|
3582 | DO 101 JL = 1, KDLON |
---|
3583 | IMX(JL)=0 |
---|
3584 | IMXP(JL)=0 |
---|
3585 | ZCLOUD(JL) = 0. |
---|
3586 | 101 CONTINUE |
---|
3587 | C |
---|
3588 | C* 1.1 SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD |
---|
3589 | C ------------------------------------------- |
---|
3590 | C |
---|
3591 | 110 CONTINUE |
---|
3592 | C |
---|
3593 | DO 112 JK = 1 , KFLEV |
---|
3594 | DO 111 JL = 1, KDLON |
---|
3595 | IMX1=IMX(JL) |
---|
3596 | IMX2=JK |
---|
3597 | IF (PCLDLU(JL,JK).GT.ZEPSC) THEN |
---|
3598 | IMXP(JL)=IMX2 |
---|
3599 | ELSE |
---|
3600 | IMXP(JL)=IMX1 |
---|
3601 | END IF |
---|
3602 | IMAXC=MAX(IMXP(JL),IMAXC) |
---|
3603 | IMX(JL)=IMXP(JL) |
---|
3604 | 111 CONTINUE |
---|
3605 | 112 CONTINUE |
---|
3606 | CGM******* |
---|
3607 | IMAXC=KFLEV |
---|
3608 | CGM******* |
---|
3609 | C |
---|
3610 | DO 114 JK = 1 , KFLEV+1 |
---|
3611 | DO 113 JL = 1, KDLON |
---|
3612 | PFLUX(JL,1,JK) = PFLUC(JL,1,JK) |
---|
3613 | PFLUX(JL,2,JK) = PFLUC(JL,2,JK) |
---|
3614 | 113 CONTINUE |
---|
3615 | 114 CONTINUE |
---|
3616 | C |
---|
3617 | C ------------------------------------------------------------------ |
---|
3618 | C |
---|
3619 | C* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES |
---|
3620 | C --------------------------------------- |
---|
3621 | C |
---|
3622 | IF (IMAXC.GT.0) THEN |
---|
3623 | C |
---|
3624 | IMXP1 = IMAXC + 1 |
---|
3625 | IMXM1 = IMAXC - 1 |
---|
3626 | C |
---|
3627 | C* 2.0 INITIALIZE TO CLEAR-SKY FLUXES |
---|
3628 | C ------------------------------ |
---|
3629 | C |
---|
3630 | 200 CONTINUE |
---|
3631 | C |
---|
3632 | DO 203 JK1=1,KFLEV+1 |
---|
3633 | DO 202 JK2=1,KFLEV+1 |
---|
3634 | DO 201 JL = 1, KDLON |
---|
3635 | ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1) |
---|
3636 | ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1) |
---|
3637 | 201 CONTINUE |
---|
3638 | 202 CONTINUE |
---|
3639 | 203 CONTINUE |
---|
3640 | C |
---|
3641 | C* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD |
---|
3642 | C ---------------------------------------------- |
---|
3643 | C |
---|
3644 | 210 CONTINUE |
---|
3645 | C |
---|
3646 | DO 213 JKC = 1 , IMAXC |
---|
3647 | JCLOUD=JKC |
---|
3648 | JKCP1=JCLOUD+1 |
---|
3649 | C |
---|
3650 | C* 2.1.1 ABOVE THE CLOUD |
---|
3651 | C --------------- |
---|
3652 | C |
---|
3653 | 2110 CONTINUE |
---|
3654 | C |
---|
3655 | DO 2115 JK=JKCP1,KFLEV+1 |
---|
3656 | JKM1=JK-1 |
---|
3657 | DO 2111 JL = 1, KDLON |
---|
3658 | ZFU(JL)=0. |
---|
3659 | 2111 CONTINUE |
---|
3660 | IF (JK .GT. JKCP1) THEN |
---|
3661 | DO 2113 JKJ=JKCP1,JKM1 |
---|
3662 | DO 2112 JL = 1, KDLON |
---|
3663 | ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ) |
---|
3664 | 2112 CONTINUE |
---|
3665 | 2113 CONTINUE |
---|
3666 | END IF |
---|
3667 | C |
---|
3668 | DO 2114 JL = 1, KDLON |
---|
3669 | ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL) |
---|
3670 | 2114 CONTINUE |
---|
3671 | 2115 CONTINUE |
---|
3672 | C |
---|
3673 | C* 2.1.2 BELOW THE CLOUD |
---|
3674 | C --------------- |
---|
3675 | C |
---|
3676 | 2120 CONTINUE |
---|
3677 | C |
---|
3678 | DO 2125 JK=1,JCLOUD |
---|
3679 | JKP1=JK+1 |
---|
3680 | DO 2121 JL = 1, KDLON |
---|
3681 | ZFD(JL)=0. |
---|
3682 | 2121 CONTINUE |
---|
3683 | C |
---|
3684 | IF (JK .LT. JCLOUD) THEN |
---|
3685 | DO 2123 JKJ=JKP1,JCLOUD |
---|
3686 | DO 2122 JL = 1, KDLON |
---|
3687 | ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ) |
---|
3688 | 2122 CONTINUE |
---|
3689 | 2123 CONTINUE |
---|
3690 | END IF |
---|
3691 | DO 2124 JL = 1, KDLON |
---|
3692 | ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL) |
---|
3693 | 2124 CONTINUE |
---|
3694 | 2125 CONTINUE |
---|
3695 | C |
---|
3696 | 213 CONTINUE |
---|
3697 | C |
---|
3698 | C |
---|
3699 | C* 2.2 CLOUD COVER MATRIX |
---|
3700 | C ------------------ |
---|
3701 | C |
---|
3702 | C* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN |
---|
3703 | C HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1 |
---|
3704 | C |
---|
3705 | 220 CONTINUE |
---|
3706 | C |
---|
3707 | DO 223 JK1 = 1 , KFLEV+1 |
---|
3708 | DO 222 JK2 = 1 , KFLEV+1 |
---|
3709 | DO 221 JL = 1, KDLON |
---|
3710 | ZCLM(JL,JK1,JK2) = 0. |
---|
3711 | 221 CONTINUE |
---|
3712 | 222 CONTINUE |
---|
3713 | 223 CONTINUE |
---|
3714 | C |
---|
3715 | C |
---|
3716 | C |
---|
3717 | C* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION |
---|
3718 | C ------------------------------------------ |
---|
3719 | C |
---|
3720 | 240 CONTINUE |
---|
3721 | C |
---|
3722 | DO 244 JK1 = 2 , KFLEV+1 |
---|
3723 | DO 241 JL = 1, KDLON |
---|
3724 | ZCLEAR(JL)=1. |
---|
3725 | ZCLOUD(JL)=0. |
---|
3726 | 241 CONTINUE |
---|
3727 | DO 243 JK = JK1 - 1 , 1 , -1 |
---|
3728 | DO 242 JL = 1, KDLON |
---|
3729 | IF (NOVLP.EQ.1) THEN |
---|
3730 | c* maximum-random |
---|
3731 | ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) |
---|
3732 | * /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
---|
3733 | ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL) |
---|
3734 | ZCLOUD(JL) = PCLDLU(JL,JK) |
---|
3735 | ELSE IF (NOVLP.EQ.2) THEN |
---|
3736 | c* maximum |
---|
3737 | ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK)) |
---|
3738 | ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
---|
3739 | ELSE IF (NOVLP.EQ.3) THEN |
---|
3740 | c* random |
---|
3741 | ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK)) |
---|
3742 | ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
---|
3743 | ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
---|
3744 | END IF |
---|
3745 | 242 CONTINUE |
---|
3746 | 243 CONTINUE |
---|
3747 | 244 CONTINUE |
---|
3748 | C |
---|
3749 | C |
---|
3750 | C* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION |
---|
3751 | C ------------------------------------------ |
---|
3752 | C |
---|
3753 | 250 CONTINUE |
---|
3754 | C |
---|
3755 | DO 254 JK1 = 1 , KFLEV |
---|
3756 | DO 251 JL = 1, KDLON |
---|
3757 | ZCLEAR(JL)=1. |
---|
3758 | ZCLOUD(JL)=0. |
---|
3759 | 251 CONTINUE |
---|
3760 | DO 253 JK = JK1 , KFLEV |
---|
3761 | DO 252 JL = 1, KDLON |
---|
3762 | IF (NOVLP.EQ.1) THEN |
---|
3763 | c* maximum-random |
---|
3764 | ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) |
---|
3765 | * /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC)) |
---|
3766 | ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL) |
---|
3767 | ZCLOUD(JL) = PCLDLD(JL,JK) |
---|
3768 | ELSE IF (NOVLP.EQ.2) THEN |
---|
3769 | c* maximum |
---|
3770 | ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK)) |
---|
3771 | ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
---|
3772 | ELSE IF (NOVLP.EQ.3) THEN |
---|
3773 | c* random |
---|
3774 | ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK)) |
---|
3775 | ZCLOUD(JL) = 1.0 - ZCLEAR(JL) |
---|
3776 | ZCLM(JL,JK1,JK) = ZCLOUD(JL) |
---|
3777 | END IF |
---|
3778 | 252 CONTINUE |
---|
3779 | 253 CONTINUE |
---|
3780 | 254 CONTINUE |
---|
3781 | C |
---|
3782 | C |
---|
3783 | C |
---|
3784 | C* 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS |
---|
3785 | C ---------------------------------------------- |
---|
3786 | C |
---|
3787 | 300 CONTINUE |
---|
3788 | C |
---|
3789 | C* 3.1 DOWNWARD FLUXES |
---|
3790 | C --------------- |
---|
3791 | C |
---|
3792 | 310 CONTINUE |
---|
3793 | C |
---|
3794 | DO 311 JL = 1, KDLON |
---|
3795 | PFLUX(JL,2,KFLEV+1) = 0. |
---|
3796 | 311 CONTINUE |
---|
3797 | C |
---|
3798 | DO 317 JK1 = KFLEV , 1 , -1 |
---|
3799 | C |
---|
3800 | C* CONTRIBUTION FROM CLEAR-SKY FRACTION |
---|
3801 | C |
---|
3802 | DO 312 JL = 1, KDLON |
---|
3803 | ZFD (JL) = (1. - ZCLM(JL,JK1,KFLEV)) * ZDNF(JL,1,JK1) |
---|
3804 | 312 CONTINUE |
---|
3805 | C |
---|
3806 | C* CONTRIBUTION FROM ADJACENT CLOUD |
---|
3807 | C |
---|
3808 | DO 313 JL = 1, KDLON |
---|
3809 | ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1) |
---|
3810 | 313 CONTINUE |
---|
3811 | C |
---|
3812 | C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS |
---|
3813 | C |
---|
3814 | DO 315 JK = KFLEV-1 , JK1 , -1 |
---|
3815 | DO 314 JL = 1, KDLON |
---|
3816 | ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK) |
---|
3817 | ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1) |
---|
3818 | 314 CONTINUE |
---|
3819 | 315 CONTINUE |
---|
3820 | C |
---|
3821 | DO 316 JL = 1, KDLON |
---|
3822 | PFLUX(JL,2,JK1) = ZFD (JL) |
---|
3823 | 316 CONTINUE |
---|
3824 | C |
---|
3825 | 317 CONTINUE |
---|
3826 | C |
---|
3827 | C |
---|
3828 | C |
---|
3829 | C |
---|
3830 | C* 3.2 UPWARD FLUX AT THE SURFACE |
---|
3831 | C -------------------------- |
---|
3832 | C |
---|
3833 | 320 CONTINUE |
---|
3834 | C |
---|
3835 | DO 321 JL = 1, KDLON |
---|
3836 | PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1) |
---|
3837 | 321 CONTINUE |
---|
3838 | C |
---|
3839 | C |
---|
3840 | C |
---|
3841 | C* 3.3 UPWARD FLUXES |
---|
3842 | C ------------- |
---|
3843 | C |
---|
3844 | 330 CONTINUE |
---|
3845 | C |
---|
3846 | DO 337 JK1 = 2 , KFLEV+1 |
---|
3847 | C |
---|
3848 | C* CONTRIBUTION FROM CLEAR-SKY FRACTION |
---|
3849 | C |
---|
3850 | DO 332 JL = 1, KDLON |
---|
3851 | ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1) |
---|
3852 | 332 CONTINUE |
---|
3853 | C |
---|
3854 | C* CONTRIBUTION FROM ADJACENT CLOUD |
---|
3855 | C |
---|
3856 | DO 333 JL = 1, KDLON |
---|
3857 | ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1) |
---|
3858 | 333 CONTINUE |
---|
3859 | C |
---|
3860 | C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS |
---|
3861 | C |
---|
3862 | DO 335 JK = 2 , JK1-1 |
---|
3863 | DO 334 JL = 1, KDLON |
---|
3864 | ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK) |
---|
3865 | ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1) |
---|
3866 | 334 CONTINUE |
---|
3867 | 335 CONTINUE |
---|
3868 | C |
---|
3869 | DO 336 JL = 1, KDLON |
---|
3870 | PFLUX(JL,1,JK1) = ZFU (JL) |
---|
3871 | 336 CONTINUE |
---|
3872 | C |
---|
3873 | 337 CONTINUE |
---|
3874 | C |
---|
3875 | C |
---|
3876 | END IF |
---|
3877 | C |
---|
3878 | C |
---|
3879 | C* 2.3 END OF CLOUD EFFECT COMPUTATIONS |
---|
3880 | C |
---|
3881 | 230 CONTINUE |
---|
3882 | C |
---|
3883 | IF (.NOT.LEVOIGT) THEN |
---|
3884 | DO 231 JL = 1, KDLON |
---|
3885 | ZFN10(JL) = PFLUX(JL,1,KLIM) + PFLUX(JL,2,KLIM) |
---|
3886 | 231 CONTINUE |
---|
3887 | DO 233 JK = KLIM+1 , KFLEV+1 |
---|
3888 | DO 232 JL = 1, KDLON |
---|
3889 | ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1) |
---|
3890 | PFLUX(JL,1,JK) = ZFN10(JL) |
---|
3891 | PFLUX(JL,2,JK) = 0.0 |
---|
3892 | 232 CONTINUE |
---|
3893 | 233 CONTINUE |
---|
3894 | ENDIF |
---|
3895 | C |
---|
3896 | RETURN |
---|
3897 | END |
---|
3898 | SUBROUTINE LWB(PDT0,PTAVE,PTL |
---|
3899 | S , PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL |
---|
3900 | S , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP) |
---|
3901 | USE dimphy |
---|
3902 | IMPLICIT none |
---|
3903 | cym#include "dimensions.h" |
---|
3904 | cym#include "dimphy.h" |
---|
3905 | cym#include "raddim.h" |
---|
3906 | #include "raddimlw.h" |
---|
3907 | C |
---|
3908 | C----------------------------------------------------------------------- |
---|
3909 | C PURPOSE. |
---|
3910 | C -------- |
---|
3911 | C COMPUTES PLANCK FUNCTIONS |
---|
3912 | C |
---|
3913 | C EXPLICIT ARGUMENTS : |
---|
3914 | C -------------------- |
---|
3915 | C ==== INPUTS === |
---|
3916 | C PDT0 : (KDLON) ; SURFACE TEMPERATURE DISCONTINUITY |
---|
3917 | C PTAVE : (KDLON,KFLEV) ; TEMPERATURE |
---|
3918 | C PTL : (KDLON,0:KFLEV) ; HALF LEVEL TEMPERATURE |
---|
3919 | C ==== OUTPUTS === |
---|
3920 | C PB : (KDLON,Ninter,KFLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION |
---|
3921 | C PBINT : (KDLON,KFLEV+1) ; HALF LEVEL PLANCK FUNCTION |
---|
3922 | C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION |
---|
3923 | C PBSUR : (KDLON,Ninter) ; SURFACE SPECTRAL PLANCK FUNCTION |
---|
3924 | C PBTOP : (KDLON,Ninter) ; TOP SPECTRAL PLANCK FUNCTION |
---|
3925 | C PDBSL : (KDLON,Ninter,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT |
---|
3926 | C PGA : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS |
---|
3927 | C PGB : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS |
---|
3928 | C PGASUR, PGBSUR (KDLON,8,2) ; SURFACE PADE APPROXIMANTS |
---|
3929 | C PGATOP, PGBTOP (KDLON,8,2) ; T.O.A. PADE APPROXIMANTS |
---|
3930 | C |
---|
3931 | C IMPLICIT ARGUMENTS : NONE |
---|
3932 | C -------------------- |
---|
3933 | C |
---|
3934 | C METHOD. |
---|
3935 | C ------- |
---|
3936 | C |
---|
3937 | C 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS |
---|
3938 | C FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION |
---|
3939 | C |
---|
3940 | C REFERENCE. |
---|
3941 | C ---------- |
---|
3942 | C |
---|
3943 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
3944 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS " |
---|
3945 | C |
---|
3946 | C AUTHOR. |
---|
3947 | C ------- |
---|
3948 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
3949 | C |
---|
3950 | C MODIFICATIONS. |
---|
3951 | C -------------- |
---|
3952 | C ORIGINAL : 89-07-14 |
---|
3953 | C |
---|
3954 | C----------------------------------------------------------------------- |
---|
3955 | C |
---|
3956 | C ARGUMENTS: |
---|
3957 | C |
---|
3958 | REAL*8 PDT0(KDLON) |
---|
3959 | REAL*8 PTAVE(KDLON,KFLEV) |
---|
3960 | REAL*8 PTL(KDLON,KFLEV+1) |
---|
3961 | C |
---|
3962 | REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION |
---|
3963 | REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION |
---|
3964 | REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
---|
3965 | REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION |
---|
3966 | REAL*8 PBTOP(KDLON,Ninter) ! TOP SPECTRAL PLANCK FUNCTION |
---|
3967 | REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
---|
3968 | REAL*8 PGA(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS |
---|
3969 | REAL*8 PGB(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS |
---|
3970 | REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
---|
3971 | REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
---|
3972 | REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
---|
3973 | REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
---|
3974 | C |
---|
3975 | C------------------------------------------------------------------------- |
---|
3976 | C* LOCAL VARIABLES: |
---|
3977 | INTEGER INDB(KDLON),INDS(KDLON) |
---|
3978 | REAL*8 ZBLAY(KDLON,KFLEV),ZBLEV(KDLON,KFLEV+1) |
---|
3979 | REAL*8 ZRES(KDLON),ZRES2(KDLON),ZTI(KDLON),ZTI2(KDLON) |
---|
3980 | c |
---|
3981 | INTEGER jk, jl, ic, jnu, jf, jg |
---|
3982 | INTEGER jk1, jk2 |
---|
3983 | INTEGER k, j, ixtox, indto, ixtx, indt |
---|
3984 | INTEGER indsu, indtp |
---|
3985 | REAL*8 zdsto1, zdstox, zdst1, zdstx |
---|
3986 | c |
---|
3987 | C* Quelques parametres: |
---|
3988 | REAL*8 TSTAND |
---|
3989 | PARAMETER (TSTAND=250.0) |
---|
3990 | REAL*8 TSTP |
---|
3991 | PARAMETER (TSTP=12.5) |
---|
3992 | INTEGER MXIXT |
---|
3993 | PARAMETER (MXIXT=10) |
---|
3994 | C |
---|
3995 | C* Used Data Block: |
---|
3996 | REAL*8 TINTP(11) |
---|
3997 | SAVE TINTP |
---|
3998 | c$OMP THREADPRIVATE(TINTP) |
---|
3999 | REAL*8 GA(11,16,3), GB(11,16,3) |
---|
4000 | SAVE GA, GB |
---|
4001 | c$OMP THREADPRIVATE(GA, GB) |
---|
4002 | REAL*8 XP(6,6) |
---|
4003 | SAVE XP |
---|
4004 | c$OMP THREADPRIVATE(XP) |
---|
4005 | c |
---|
4006 | DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250., |
---|
4007 | S 262.5, 275., 287.5, 300., 312.5 / |
---|
4008 | C----------------------------------------------------------------------- |
---|
4009 | C-- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ---------------- |
---|
4010 | C |
---|
4011 | C |
---|
4012 | C |
---|
4013 | C |
---|
4014 | C-- R.D. -- G = - 0.2 SLA |
---|
4015 | C |
---|
4016 | C |
---|
4017 | C----- INTERVAL = 1 ----- T = 187.5 |
---|
4018 | C |
---|
4019 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4020 | DATA (GA( 1, 1,IC),IC=1,3) / |
---|
4021 | S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/ |
---|
4022 | DATA (GB( 1, 1,IC),IC=1,3) / |
---|
4023 | S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/ |
---|
4024 | DATA (GA( 1, 2,IC),IC=1,3) / |
---|
4025 | S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/ |
---|
4026 | DATA (GB( 1, 2,IC),IC=1,3) / |
---|
4027 | S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/ |
---|
4028 | C |
---|
4029 | C----- INTERVAL = 1 ----- T = 200.0 |
---|
4030 | C |
---|
4031 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4032 | DATA (GA( 2, 1,IC),IC=1,3) / |
---|
4033 | S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/ |
---|
4034 | DATA (GB( 2, 1,IC),IC=1,3) / |
---|
4035 | S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/ |
---|
4036 | DATA (GA( 2, 2,IC),IC=1,3) / |
---|
4037 | S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/ |
---|
4038 | DATA (GB( 2, 2,IC),IC=1,3) / |
---|
4039 | S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/ |
---|
4040 | C |
---|
4041 | C----- INTERVAL = 1 ----- T = 212.5 |
---|
4042 | C |
---|
4043 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4044 | DATA (GA( 3, 1,IC),IC=1,3) / |
---|
4045 | S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/ |
---|
4046 | DATA (GB( 3, 1,IC),IC=1,3) / |
---|
4047 | S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/ |
---|
4048 | DATA (GA( 3, 2,IC),IC=1,3) / |
---|
4049 | S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/ |
---|
4050 | DATA (GB( 3, 2,IC),IC=1,3) / |
---|
4051 | S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/ |
---|
4052 | C |
---|
4053 | C----- INTERVAL = 1 ----- T = 225.0 |
---|
4054 | C |
---|
4055 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4056 | DATA (GA( 4, 1,IC),IC=1,3) / |
---|
4057 | S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/ |
---|
4058 | DATA (GB( 4, 1,IC),IC=1,3) / |
---|
4059 | S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/ |
---|
4060 | DATA (GA( 4, 2,IC),IC=1,3) / |
---|
4061 | S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/ |
---|
4062 | DATA (GB( 4, 2,IC),IC=1,3) / |
---|
4063 | S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/ |
---|
4064 | C |
---|
4065 | C----- INTERVAL = 1 ----- T = 237.5 |
---|
4066 | C |
---|
4067 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4068 | DATA (GA( 5, 1,IC),IC=1,3) / |
---|
4069 | S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/ |
---|
4070 | DATA (GB( 5, 1,IC),IC=1,3) / |
---|
4071 | S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/ |
---|
4072 | DATA (GA( 5, 2,IC),IC=1,3) / |
---|
4073 | S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/ |
---|
4074 | DATA (GB( 5, 2,IC),IC=1,3) / |
---|
4075 | S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/ |
---|
4076 | C |
---|
4077 | C----- INTERVAL = 1 ----- T = 250.0 |
---|
4078 | C |
---|
4079 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4080 | DATA (GA( 6, 1,IC),IC=1,3) / |
---|
4081 | S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/ |
---|
4082 | DATA (GB( 6, 1,IC),IC=1,3) / |
---|
4083 | S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/ |
---|
4084 | DATA (GA( 6, 2,IC),IC=1,3) / |
---|
4085 | S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/ |
---|
4086 | DATA (GB( 6, 2,IC),IC=1,3) / |
---|
4087 | S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/ |
---|
4088 | C |
---|
4089 | C----- INTERVAL = 1 ----- T = 262.5 |
---|
4090 | C |
---|
4091 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4092 | DATA (GA( 7, 1,IC),IC=1,3) / |
---|
4093 | S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/ |
---|
4094 | DATA (GB( 7, 1,IC),IC=1,3) / |
---|
4095 | S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/ |
---|
4096 | DATA (GA( 7, 2,IC),IC=1,3) / |
---|
4097 | S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/ |
---|
4098 | DATA (GB( 7, 2,IC),IC=1,3) / |
---|
4099 | S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/ |
---|
4100 | C |
---|
4101 | C----- INTERVAL = 1 ----- T = 275.0 |
---|
4102 | C |
---|
4103 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4104 | DATA (GA( 8, 1,IC),IC=1,3) / |
---|
4105 | S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/ |
---|
4106 | DATA (GB( 8, 1,IC),IC=1,3) / |
---|
4107 | S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/ |
---|
4108 | DATA (GA( 8, 2,IC),IC=1,3) / |
---|
4109 | S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/ |
---|
4110 | DATA (GB( 8, 2,IC),IC=1,3) / |
---|
4111 | S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/ |
---|
4112 | C |
---|
4113 | C----- INTERVAL = 1 ----- T = 287.5 |
---|
4114 | C |
---|
4115 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4116 | DATA (GA( 9, 1,IC),IC=1,3) / |
---|
4117 | S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/ |
---|
4118 | DATA (GB( 9, 1,IC),IC=1,3) / |
---|
4119 | S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/ |
---|
4120 | DATA (GA( 9, 2,IC),IC=1,3) / |
---|
4121 | S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/ |
---|
4122 | DATA (GB( 9, 2,IC),IC=1,3) / |
---|
4123 | S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/ |
---|
4124 | C |
---|
4125 | C----- INTERVAL = 1 ----- T = 300.0 |
---|
4126 | C |
---|
4127 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4128 | DATA (GA(10, 1,IC),IC=1,3) / |
---|
4129 | S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/ |
---|
4130 | DATA (GB(10, 1,IC),IC=1,3) / |
---|
4131 | S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/ |
---|
4132 | DATA (GA(10, 2,IC),IC=1,3) / |
---|
4133 | S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/ |
---|
4134 | DATA (GB(10, 2,IC),IC=1,3) / |
---|
4135 | S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/ |
---|
4136 | C |
---|
4137 | C----- INTERVAL = 1 ----- T = 312.5 |
---|
4138 | C |
---|
4139 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
4140 | DATA (GA(11, 1,IC),IC=1,3) / |
---|
4141 | S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/ |
---|
4142 | DATA (GB(11, 1,IC),IC=1,3) / |
---|
4143 | S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/ |
---|
4144 | DATA (GA(11, 2,IC),IC=1,3) / |
---|
4145 | S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/ |
---|
4146 | DATA (GB(11, 2,IC),IC=1,3) / |
---|
4147 | S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/ |
---|
4148 | C |
---|
4149 | C |
---|
4150 | C |
---|
4151 | C--- WATER VAPOR --- INTERVAL 2 -- 500-800 CM-1--- FROM ABS225 --------- |
---|
4152 | C |
---|
4153 | C |
---|
4154 | C |
---|
4155 | C |
---|
4156 | C--- R.D. --- G = 0.02 + 0.50 / ( 1 + 4.5 U ) |
---|
4157 | C |
---|
4158 | C |
---|
4159 | C----- INTERVAL = 2 ----- T = 187.5 |
---|
4160 | C |
---|
4161 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4162 | DATA (GA( 1, 3,IC),IC=1,3) / |
---|
4163 | S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/ |
---|
4164 | DATA (GB( 1, 3,IC),IC=1,3) / |
---|
4165 | S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/ |
---|
4166 | DATA (GA( 1, 4,IC),IC=1,3) / |
---|
4167 | S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/ |
---|
4168 | DATA (GB( 1, 4,IC),IC=1,3) / |
---|
4169 | S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/ |
---|
4170 | C |
---|
4171 | C----- INTERVAL = 2 ----- T = 200.0 |
---|
4172 | C |
---|
4173 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4174 | DATA (GA( 2, 3,IC),IC=1,3) / |
---|
4175 | S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/ |
---|
4176 | DATA (GB( 2, 3,IC),IC=1,3) / |
---|
4177 | S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/ |
---|
4178 | DATA (GA( 2, 4,IC),IC=1,3) / |
---|
4179 | S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/ |
---|
4180 | DATA (GB( 2, 4,IC),IC=1,3) / |
---|
4181 | S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/ |
---|
4182 | C |
---|
4183 | C----- INTERVAL = 2 ----- T = 212.5 |
---|
4184 | C |
---|
4185 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4186 | DATA (GA( 3, 3,IC),IC=1,3) / |
---|
4187 | S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/ |
---|
4188 | DATA (GB( 3, 3,IC),IC=1,3) / |
---|
4189 | S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/ |
---|
4190 | DATA (GA( 3, 4,IC),IC=1,3) / |
---|
4191 | S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/ |
---|
4192 | DATA (GB( 3, 4,IC),IC=1,3) / |
---|
4193 | S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/ |
---|
4194 | C |
---|
4195 | C----- INTERVAL = 2 ----- T = 225.0 |
---|
4196 | C |
---|
4197 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4198 | DATA (GA( 4, 3,IC),IC=1,3) / |
---|
4199 | S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/ |
---|
4200 | DATA (GB( 4, 3,IC),IC=1,3) / |
---|
4201 | S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/ |
---|
4202 | DATA (GA( 4, 4,IC),IC=1,3) / |
---|
4203 | S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/ |
---|
4204 | DATA (GB( 4, 4,IC),IC=1,3) / |
---|
4205 | S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/ |
---|
4206 | C |
---|
4207 | C----- INTERVAL = 2 ----- T = 237.5 |
---|
4208 | C |
---|
4209 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4210 | DATA (GA( 5, 3,IC),IC=1,3) / |
---|
4211 | S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/ |
---|
4212 | DATA (GB( 5, 3,IC),IC=1,3) / |
---|
4213 | S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/ |
---|
4214 | DATA (GA( 5, 4,IC),IC=1,3) / |
---|
4215 | S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/ |
---|
4216 | DATA (GB( 5, 4,IC),IC=1,3) / |
---|
4217 | S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/ |
---|
4218 | C |
---|
4219 | C----- INTERVAL = 2 ----- T = 250.0 |
---|
4220 | C |
---|
4221 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4222 | DATA (GA( 6, 3,IC),IC=1,3) / |
---|
4223 | S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/ |
---|
4224 | DATA (GB( 6, 3,IC),IC=1,3) / |
---|
4225 | S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/ |
---|
4226 | DATA (GA( 6, 4,IC),IC=1,3) / |
---|
4227 | S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/ |
---|
4228 | DATA (GB( 6, 4,IC),IC=1,3) / |
---|
4229 | S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/ |
---|
4230 | C |
---|
4231 | C----- INTERVAL = 2 ----- T = 262.5 |
---|
4232 | C |
---|
4233 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4234 | DATA (GA( 7, 3,IC),IC=1,3) / |
---|
4235 | S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/ |
---|
4236 | DATA (GB( 7, 3,IC),IC=1,3) / |
---|
4237 | S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/ |
---|
4238 | DATA (GA( 7, 4,IC),IC=1,3) / |
---|
4239 | S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/ |
---|
4240 | DATA (GB( 7, 4,IC),IC=1,3) / |
---|
4241 | S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/ |
---|
4242 | C |
---|
4243 | C----- INTERVAL = 2 ----- T = 275.0 |
---|
4244 | C |
---|
4245 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4246 | DATA (GA( 8, 3,IC),IC=1,3) / |
---|
4247 | S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/ |
---|
4248 | DATA (GB( 8, 3,IC),IC=1,3) / |
---|
4249 | S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/ |
---|
4250 | DATA (GA( 8, 4,IC),IC=1,3) / |
---|
4251 | S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/ |
---|
4252 | DATA (GB( 8, 4,IC),IC=1,3) / |
---|
4253 | S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/ |
---|
4254 | C |
---|
4255 | C----- INTERVAL = 2 ----- T = 287.5 |
---|
4256 | C |
---|
4257 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4258 | DATA (GA( 9, 3,IC),IC=1,3) / |
---|
4259 | S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/ |
---|
4260 | DATA (GB( 9, 3,IC),IC=1,3) / |
---|
4261 | S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/ |
---|
4262 | DATA (GA( 9, 4,IC),IC=1,3) / |
---|
4263 | S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/ |
---|
4264 | DATA (GB( 9, 4,IC),IC=1,3) / |
---|
4265 | S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/ |
---|
4266 | C |
---|
4267 | C----- INTERVAL = 2 ----- T = 300.0 |
---|
4268 | C |
---|
4269 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4270 | DATA (GA(10, 3,IC),IC=1,3) / |
---|
4271 | S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/ |
---|
4272 | DATA (GB(10, 3,IC),IC=1,3) / |
---|
4273 | S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/ |
---|
4274 | DATA (GA(10, 4,IC),IC=1,3) / |
---|
4275 | S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/ |
---|
4276 | DATA (GB(10, 4,IC),IC=1,3) / |
---|
4277 | S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/ |
---|
4278 | C |
---|
4279 | C----- INTERVAL = 2 ----- T = 312.5 |
---|
4280 | C |
---|
4281 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4282 | DATA (GA(11, 3,IC),IC=1,3) / |
---|
4283 | S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/ |
---|
4284 | DATA (GB(11, 3,IC),IC=1,3) / |
---|
4285 | S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/ |
---|
4286 | DATA (GA(11, 4,IC),IC=1,3) / |
---|
4287 | S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/ |
---|
4288 | DATA (GB(11, 4,IC),IC=1,3) / |
---|
4289 | S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/ |
---|
4290 | C |
---|
4291 | C |
---|
4292 | C |
---|
4293 | C |
---|
4294 | C |
---|
4295 | C |
---|
4296 | C- WATER VAPOR - INT. 3 -- 800-970 + 1110-1250 CM-1 -- FIT FROM 215 IS - |
---|
4297 | C |
---|
4298 | C |
---|
4299 | C-- WATER VAPOR LINES IN THE WINDOW REGION (800-1250 CM-1) |
---|
4300 | C |
---|
4301 | C |
---|
4302 | C |
---|
4303 | C--- G = 3.875E-03 --------------- |
---|
4304 | C |
---|
4305 | C----- INTERVAL = 3 ----- T = 187.5 |
---|
4306 | C |
---|
4307 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4308 | DATA (GA( 1, 7,IC),IC=1,3) / |
---|
4309 | S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/ |
---|
4310 | DATA (GB( 1, 7,IC),IC=1,3) / |
---|
4311 | S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/ |
---|
4312 | DATA (GA( 1, 8,IC),IC=1,3) / |
---|
4313 | S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/ |
---|
4314 | DATA (GB( 1, 8,IC),IC=1,3) / |
---|
4315 | S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/ |
---|
4316 | C |
---|
4317 | C----- INTERVAL = 3 ----- T = 200.0 |
---|
4318 | C |
---|
4319 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4320 | DATA (GA( 2, 7,IC),IC=1,3) / |
---|
4321 | S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/ |
---|
4322 | DATA (GB( 2, 7,IC),IC=1,3) / |
---|
4323 | S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/ |
---|
4324 | DATA (GA( 2, 8,IC),IC=1,3) / |
---|
4325 | S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/ |
---|
4326 | DATA (GB( 2, 8,IC),IC=1,3) / |
---|
4327 | S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/ |
---|
4328 | C |
---|
4329 | C----- INTERVAL = 3 ----- T = 212.5 |
---|
4330 | C |
---|
4331 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4332 | DATA (GA( 3, 7,IC),IC=1,3) / |
---|
4333 | S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/ |
---|
4334 | DATA (GB( 3, 7,IC),IC=1,3) / |
---|
4335 | S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/ |
---|
4336 | DATA (GA( 3, 8,IC),IC=1,3) / |
---|
4337 | S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/ |
---|
4338 | DATA (GB( 3, 8,IC),IC=1,3) / |
---|
4339 | S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/ |
---|
4340 | C |
---|
4341 | C----- INTERVAL = 3 ----- T = 225.0 |
---|
4342 | C |
---|
4343 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4344 | DATA (GA( 4, 7,IC),IC=1,3) / |
---|
4345 | S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/ |
---|
4346 | DATA (GB( 4, 7,IC),IC=1,3) / |
---|
4347 | S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/ |
---|
4348 | DATA (GA( 4, 8,IC),IC=1,3) / |
---|
4349 | S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/ |
---|
4350 | DATA (GB( 4, 8,IC),IC=1,3) / |
---|
4351 | S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/ |
---|
4352 | C |
---|
4353 | C----- INTERVAL = 3 ----- T = 237.5 |
---|
4354 | C |
---|
4355 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4356 | DATA (GA( 5, 7,IC),IC=1,3) / |
---|
4357 | S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/ |
---|
4358 | DATA (GB( 5, 7,IC),IC=1,3) / |
---|
4359 | S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/ |
---|
4360 | DATA (GA( 5, 8,IC),IC=1,3) / |
---|
4361 | S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/ |
---|
4362 | DATA (GB( 5, 8,IC),IC=1,3) / |
---|
4363 | S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/ |
---|
4364 | C |
---|
4365 | C----- INTERVAL = 3 ----- T = 250.0 |
---|
4366 | C |
---|
4367 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4368 | DATA (GA( 6, 7,IC),IC=1,3) / |
---|
4369 | S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/ |
---|
4370 | DATA (GB( 6, 7,IC),IC=1,3) / |
---|
4371 | S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/ |
---|
4372 | DATA (GA( 6, 8,IC),IC=1,3) / |
---|
4373 | S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/ |
---|
4374 | DATA (GB( 6, 8,IC),IC=1,3) / |
---|
4375 | S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/ |
---|
4376 | C |
---|
4377 | C----- INTERVAL = 3 ----- T = 262.5 |
---|
4378 | C |
---|
4379 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4380 | DATA (GA( 7, 7,IC),IC=1,3) / |
---|
4381 | S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/ |
---|
4382 | DATA (GB( 7, 7,IC),IC=1,3) / |
---|
4383 | S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/ |
---|
4384 | DATA (GA( 7, 8,IC),IC=1,3) / |
---|
4385 | S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/ |
---|
4386 | DATA (GB( 7, 8,IC),IC=1,3) / |
---|
4387 | S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/ |
---|
4388 | C |
---|
4389 | C----- INTERVAL = 3 ----- T = 275.0 |
---|
4390 | C |
---|
4391 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4392 | DATA (GA( 8, 7,IC),IC=1,3) / |
---|
4393 | S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/ |
---|
4394 | DATA (GB( 8, 7,IC),IC=1,3) / |
---|
4395 | S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/ |
---|
4396 | DATA (GA( 8, 8,IC),IC=1,3) / |
---|
4397 | S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/ |
---|
4398 | DATA (GB( 8, 8,IC),IC=1,3) / |
---|
4399 | S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/ |
---|
4400 | C |
---|
4401 | C----- INTERVAL = 3 ----- T = 287.5 |
---|
4402 | C |
---|
4403 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4404 | DATA (GA( 9, 7,IC),IC=1,3) / |
---|
4405 | S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/ |
---|
4406 | DATA (GB( 9, 7,IC),IC=1,3) / |
---|
4407 | S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/ |
---|
4408 | DATA (GA( 9, 8,IC),IC=1,3) / |
---|
4409 | S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/ |
---|
4410 | DATA (GB( 9, 8,IC),IC=1,3) / |
---|
4411 | S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/ |
---|
4412 | C |
---|
4413 | C----- INTERVAL = 3 ----- T = 300.0 |
---|
4414 | C |
---|
4415 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4416 | DATA (GA(10, 7,IC),IC=1,3) / |
---|
4417 | S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/ |
---|
4418 | DATA (GB(10, 7,IC),IC=1,3) / |
---|
4419 | S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/ |
---|
4420 | DATA (GA(10, 8,IC),IC=1,3) / |
---|
4421 | S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/ |
---|
4422 | DATA (GB(10, 8,IC),IC=1,3) / |
---|
4423 | S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/ |
---|
4424 | C |
---|
4425 | C----- INTERVAL = 3 ----- T = 312.5 |
---|
4426 | C |
---|
4427 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4428 | DATA (GA(11, 7,IC),IC=1,3) / |
---|
4429 | S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/ |
---|
4430 | DATA (GB(11, 7,IC),IC=1,3) / |
---|
4431 | S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/ |
---|
4432 | DATA (GA(11, 8,IC),IC=1,3) / |
---|
4433 | S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/ |
---|
4434 | DATA (GB(11, 8,IC),IC=1,3) / |
---|
4435 | S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/ |
---|
4436 | C |
---|
4437 | C |
---|
4438 | C-- WATER VAPOR -- 970-1110 CM-1 ---------------------------------------- |
---|
4439 | C |
---|
4440 | C-- G = 3.6E-03 |
---|
4441 | C |
---|
4442 | C----- INTERVAL = 4 ----- T = 187.5 |
---|
4443 | C |
---|
4444 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4445 | DATA (GA( 1, 9,IC),IC=1,3) / |
---|
4446 | S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/ |
---|
4447 | DATA (GB( 1, 9,IC),IC=1,3) / |
---|
4448 | S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/ |
---|
4449 | DATA (GA( 1,10,IC),IC=1,3) / |
---|
4450 | S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/ |
---|
4451 | DATA (GB( 1,10,IC),IC=1,3) / |
---|
4452 | S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/ |
---|
4453 | C |
---|
4454 | C----- INTERVAL = 4 ----- T = 200.0 |
---|
4455 | C |
---|
4456 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4457 | DATA (GA( 2, 9,IC),IC=1,3) / |
---|
4458 | S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/ |
---|
4459 | DATA (GB( 2, 9,IC),IC=1,3) / |
---|
4460 | S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/ |
---|
4461 | DATA (GA( 2,10,IC),IC=1,3) / |
---|
4462 | S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/ |
---|
4463 | DATA (GB( 2,10,IC),IC=1,3) / |
---|
4464 | S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/ |
---|
4465 | C |
---|
4466 | C----- INTERVAL = 4 ----- T = 212.5 |
---|
4467 | C |
---|
4468 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4469 | DATA (GA( 3, 9,IC),IC=1,3) / |
---|
4470 | S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/ |
---|
4471 | DATA (GB( 3, 9,IC),IC=1,3) / |
---|
4472 | S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/ |
---|
4473 | DATA (GA( 3,10,IC),IC=1,3) / |
---|
4474 | S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/ |
---|
4475 | DATA (GB( 3,10,IC),IC=1,3) / |
---|
4476 | S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/ |
---|
4477 | C |
---|
4478 | C----- INTERVAL = 4 ----- T = 225.0 |
---|
4479 | C |
---|
4480 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4481 | DATA (GA( 4, 9,IC),IC=1,3) / |
---|
4482 | S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/ |
---|
4483 | DATA (GB( 4, 9,IC),IC=1,3) / |
---|
4484 | S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/ |
---|
4485 | DATA (GA( 4,10,IC),IC=1,3) / |
---|
4486 | S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/ |
---|
4487 | DATA (GB( 4,10,IC),IC=1,3) / |
---|
4488 | S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/ |
---|
4489 | C |
---|
4490 | C----- INTERVAL = 4 ----- T = 237.5 |
---|
4491 | C |
---|
4492 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4493 | DATA (GA( 5, 9,IC),IC=1,3) / |
---|
4494 | S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/ |
---|
4495 | DATA (GB( 5, 9,IC),IC=1,3) / |
---|
4496 | S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/ |
---|
4497 | DATA (GA( 5,10,IC),IC=1,3) / |
---|
4498 | S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/ |
---|
4499 | DATA (GB( 5,10,IC),IC=1,3) / |
---|
4500 | S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/ |
---|
4501 | C |
---|
4502 | C----- INTERVAL = 4 ----- T = 250.0 |
---|
4503 | C |
---|
4504 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4505 | DATA (GA( 6, 9,IC),IC=1,3) / |
---|
4506 | S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/ |
---|
4507 | DATA (GB( 6, 9,IC),IC=1,3) / |
---|
4508 | S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/ |
---|
4509 | DATA (GA( 6,10,IC),IC=1,3) / |
---|
4510 | S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/ |
---|
4511 | DATA (GB( 6,10,IC),IC=1,3) / |
---|
4512 | S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/ |
---|
4513 | C |
---|
4514 | C----- INTERVAL = 4 ----- T = 262.5 |
---|
4515 | C |
---|
4516 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4517 | DATA (GA( 7, 9,IC),IC=1,3) / |
---|
4518 | S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/ |
---|
4519 | DATA (GB( 7, 9,IC),IC=1,3) / |
---|
4520 | S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/ |
---|
4521 | DATA (GA( 7,10,IC),IC=1,3) / |
---|
4522 | S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/ |
---|
4523 | DATA (GB( 7,10,IC),IC=1,3) / |
---|
4524 | S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/ |
---|
4525 | C |
---|
4526 | C----- INTERVAL = 4 ----- T = 275.0 |
---|
4527 | C |
---|
4528 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4529 | DATA (GA( 8, 9,IC),IC=1,3) / |
---|
4530 | S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/ |
---|
4531 | DATA (GB( 8, 9,IC),IC=1,3) / |
---|
4532 | S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/ |
---|
4533 | DATA (GA( 8,10,IC),IC=1,3) / |
---|
4534 | S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/ |
---|
4535 | DATA (GB( 8,10,IC),IC=1,3) / |
---|
4536 | S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/ |
---|
4537 | C |
---|
4538 | C----- INTERVAL = 4 ----- T = 287.5 |
---|
4539 | C |
---|
4540 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4541 | DATA (GA( 9, 9,IC),IC=1,3) / |
---|
4542 | S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/ |
---|
4543 | DATA (GB( 9, 9,IC),IC=1,3) / |
---|
4544 | S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/ |
---|
4545 | DATA (GA( 9,10,IC),IC=1,3) / |
---|
4546 | S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/ |
---|
4547 | DATA (GB( 9,10,IC),IC=1,3) / |
---|
4548 | S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/ |
---|
4549 | C |
---|
4550 | C----- INTERVAL = 4 ----- T = 300.0 |
---|
4551 | C |
---|
4552 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4553 | DATA (GA(10, 9,IC),IC=1,3) / |
---|
4554 | S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/ |
---|
4555 | DATA (GB(10, 9,IC),IC=1,3) / |
---|
4556 | S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/ |
---|
4557 | DATA (GA(10,10,IC),IC=1,3) / |
---|
4558 | S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/ |
---|
4559 | DATA (GB(10,10,IC),IC=1,3) / |
---|
4560 | S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/ |
---|
4561 | C |
---|
4562 | C----- INTERVAL = 4 ----- T = 312.5 |
---|
4563 | C |
---|
4564 | C-- INDICES FOR PADE APPROXIMATION 1 28 37 45 |
---|
4565 | DATA (GA(11, 9,IC),IC=1,3) / |
---|
4566 | S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/ |
---|
4567 | DATA (GB(11, 9,IC),IC=1,3) / |
---|
4568 | S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/ |
---|
4569 | DATA (GA(11,10,IC),IC=1,3) / |
---|
4570 | S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/ |
---|
4571 | DATA (GB(11,10,IC),IC=1,3) / |
---|
4572 | S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/ |
---|
4573 | C |
---|
4574 | C |
---|
4575 | C |
---|
4576 | C-- H2O -- WEAKER PARTS OF THE STRONG BANDS -- FROM ABS225 ---- |
---|
4577 | C |
---|
4578 | C-- WATER VAPOR --- 350 - 500 CM-1 |
---|
4579 | C |
---|
4580 | C-- G = - 0.2*SLA, 0.0 +0.5/(1+0.5U) |
---|
4581 | C |
---|
4582 | C----- INTERVAL = 5 ----- T = 187.5 |
---|
4583 | C |
---|
4584 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4585 | DATA (GA( 1, 5,IC),IC=1,3) / |
---|
4586 | S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/ |
---|
4587 | DATA (GB( 1, 5,IC),IC=1,3) / |
---|
4588 | S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/ |
---|
4589 | DATA (GA( 1, 6,IC),IC=1,3) / |
---|
4590 | S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/ |
---|
4591 | DATA (GB( 1, 6,IC),IC=1,3) / |
---|
4592 | S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/ |
---|
4593 | C |
---|
4594 | C----- INTERVAL = 5 ----- T = 200.0 |
---|
4595 | C |
---|
4596 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4597 | DATA (GA( 2, 5,IC),IC=1,3) / |
---|
4598 | S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/ |
---|
4599 | DATA (GB( 2, 5,IC),IC=1,3) / |
---|
4600 | S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/ |
---|
4601 | DATA (GA( 2, 6,IC),IC=1,3) / |
---|
4602 | S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/ |
---|
4603 | DATA (GB( 2, 6,IC),IC=1,3) / |
---|
4604 | S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/ |
---|
4605 | C |
---|
4606 | C----- INTERVAL = 5 ----- T = 212.5 |
---|
4607 | C |
---|
4608 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4609 | DATA (GA( 3, 5,IC),IC=1,3) / |
---|
4610 | S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/ |
---|
4611 | DATA (GB( 3, 5,IC),IC=1,3) / |
---|
4612 | S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/ |
---|
4613 | DATA (GA( 3, 6,IC),IC=1,3) / |
---|
4614 | S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/ |
---|
4615 | DATA (GB( 3, 6,IC),IC=1,3) / |
---|
4616 | S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/ |
---|
4617 | C |
---|
4618 | C----- INTERVAL = 5 ----- T = 225.0 |
---|
4619 | C |
---|
4620 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4621 | DATA (GA( 4, 5,IC),IC=1,3) / |
---|
4622 | S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/ |
---|
4623 | DATA (GB( 4, 5,IC),IC=1,3) / |
---|
4624 | S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/ |
---|
4625 | DATA (GA( 4, 6,IC),IC=1,3) / |
---|
4626 | S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/ |
---|
4627 | DATA (GB( 4, 6,IC),IC=1,3) / |
---|
4628 | S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/ |
---|
4629 | C |
---|
4630 | C----- INTERVAL = 5 ----- T = 237.5 |
---|
4631 | C |
---|
4632 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4633 | DATA (GA( 5, 5,IC),IC=1,3) / |
---|
4634 | S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/ |
---|
4635 | DATA (GB( 5, 5,IC),IC=1,3) / |
---|
4636 | S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/ |
---|
4637 | DATA (GA( 5, 6,IC),IC=1,3) / |
---|
4638 | S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/ |
---|
4639 | DATA (GB( 5, 6,IC),IC=1,3) / |
---|
4640 | S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/ |
---|
4641 | C |
---|
4642 | C----- INTERVAL = 5 ----- T = 250.0 |
---|
4643 | C |
---|
4644 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4645 | DATA (GA( 6, 5,IC),IC=1,3) / |
---|
4646 | S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/ |
---|
4647 | DATA (GB( 6, 5,IC),IC=1,3) / |
---|
4648 | S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/ |
---|
4649 | DATA (GA( 6, 6,IC),IC=1,3) / |
---|
4650 | S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/ |
---|
4651 | DATA (GB( 6, 6,IC),IC=1,3) / |
---|
4652 | S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/ |
---|
4653 | C |
---|
4654 | C----- INTERVAL = 5 ----- T = 262.5 |
---|
4655 | C |
---|
4656 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4657 | DATA (GA( 7, 5,IC),IC=1,3) / |
---|
4658 | S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/ |
---|
4659 | DATA (GB( 7, 5,IC),IC=1,3) / |
---|
4660 | S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/ |
---|
4661 | DATA (GA( 7, 6,IC),IC=1,3) / |
---|
4662 | S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/ |
---|
4663 | DATA (GB( 7, 6,IC),IC=1,3) / |
---|
4664 | S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/ |
---|
4665 | C |
---|
4666 | C----- INTERVAL = 5 ----- T = 275.0 |
---|
4667 | C |
---|
4668 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4669 | DATA (GA( 8, 5,IC),IC=1,3) / |
---|
4670 | S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/ |
---|
4671 | DATA (GB( 8, 5,IC),IC=1,3) / |
---|
4672 | S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/ |
---|
4673 | DATA (GA( 8, 6,IC),IC=1,3) / |
---|
4674 | S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/ |
---|
4675 | DATA (GB( 8, 6,IC),IC=1,3) / |
---|
4676 | S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/ |
---|
4677 | C |
---|
4678 | C----- INTERVAL = 5 ----- T = 287.5 |
---|
4679 | C |
---|
4680 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4681 | DATA (GA( 9, 5,IC),IC=1,3) / |
---|
4682 | S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/ |
---|
4683 | DATA (GB( 9, 5,IC),IC=1,3) / |
---|
4684 | S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/ |
---|
4685 | DATA (GA( 9, 6,IC),IC=1,3) / |
---|
4686 | S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/ |
---|
4687 | DATA (GB( 9, 6,IC),IC=1,3) / |
---|
4688 | S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/ |
---|
4689 | C |
---|
4690 | C----- INTERVAL = 5 ----- T = 300.0 |
---|
4691 | C |
---|
4692 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4693 | DATA (GA(10, 5,IC),IC=1,3) / |
---|
4694 | S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/ |
---|
4695 | DATA (GB(10, 5,IC),IC=1,3) / |
---|
4696 | S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/ |
---|
4697 | DATA (GA(10, 6,IC),IC=1,3) / |
---|
4698 | S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/ |
---|
4699 | DATA (GB(10, 6,IC),IC=1,3) / |
---|
4700 | S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/ |
---|
4701 | C |
---|
4702 | C----- INTERVAL = 5 ----- T = 312.5 |
---|
4703 | C |
---|
4704 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4705 | DATA (GA(11, 5,IC),IC=1,3) / |
---|
4706 | S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/ |
---|
4707 | DATA (GB(11, 5,IC),IC=1,3) / |
---|
4708 | S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/ |
---|
4709 | DATA (GA(11, 6,IC),IC=1,3) / |
---|
4710 | S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/ |
---|
4711 | DATA (GB(11, 6,IC),IC=1,3) / |
---|
4712 | S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/ |
---|
4713 | C |
---|
4714 | C |
---|
4715 | C |
---|
4716 | C |
---|
4717 | C- WATER VAPOR - WINGS OF VIBRATION-ROTATION BAND - 1250-1450+1880-2820 - |
---|
4718 | C--- G = 0.0 |
---|
4719 | C |
---|
4720 | C |
---|
4721 | C----- INTERVAL = 6 ----- T = 187.5 |
---|
4722 | C |
---|
4723 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4724 | DATA (GA( 1,11,IC),IC=1,3) / |
---|
4725 | S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/ |
---|
4726 | DATA (GB( 1,11,IC),IC=1,3) / |
---|
4727 | S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/ |
---|
4728 | DATA (GA( 1,12,IC),IC=1,3) / |
---|
4729 | S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/ |
---|
4730 | DATA (GB( 1,12,IC),IC=1,3) / |
---|
4731 | S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/ |
---|
4732 | C |
---|
4733 | C----- INTERVAL = 6 ----- T = 200.0 |
---|
4734 | C |
---|
4735 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4736 | DATA (GA( 2,11,IC),IC=1,3) / |
---|
4737 | S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/ |
---|
4738 | DATA (GB( 2,11,IC),IC=1,3) / |
---|
4739 | S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/ |
---|
4740 | DATA (GA( 2,12,IC),IC=1,3) / |
---|
4741 | S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/ |
---|
4742 | DATA (GB( 2,12,IC),IC=1,3) / |
---|
4743 | S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/ |
---|
4744 | C |
---|
4745 | C----- INTERVAL = 6 ----- T = 212.5 |
---|
4746 | C |
---|
4747 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4748 | DATA (GA( 3,11,IC),IC=1,3) / |
---|
4749 | S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/ |
---|
4750 | DATA (GB( 3,11,IC),IC=1,3) / |
---|
4751 | S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/ |
---|
4752 | DATA (GA( 3,12,IC),IC=1,3) / |
---|
4753 | S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/ |
---|
4754 | DATA (GB( 3,12,IC),IC=1,3) / |
---|
4755 | S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/ |
---|
4756 | C |
---|
4757 | C----- INTERVAL = 6 ----- T = 225.0 |
---|
4758 | C |
---|
4759 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4760 | DATA (GA( 4,11,IC),IC=1,3) / |
---|
4761 | S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/ |
---|
4762 | DATA (GB( 4,11,IC),IC=1,3) / |
---|
4763 | S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/ |
---|
4764 | DATA (GA( 4,12,IC),IC=1,3) / |
---|
4765 | S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/ |
---|
4766 | DATA (GB( 4,12,IC),IC=1,3) / |
---|
4767 | S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/ |
---|
4768 | C |
---|
4769 | C----- INTERVAL = 6 ----- T = 237.5 |
---|
4770 | C |
---|
4771 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4772 | DATA (GA( 5,11,IC),IC=1,3) / |
---|
4773 | S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/ |
---|
4774 | DATA (GB( 5,11,IC),IC=1,3) / |
---|
4775 | S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/ |
---|
4776 | DATA (GA( 5,12,IC),IC=1,3) / |
---|
4777 | S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/ |
---|
4778 | DATA (GB( 5,12,IC),IC=1,3) / |
---|
4779 | S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/ |
---|
4780 | C |
---|
4781 | C----- INTERVAL = 6 ----- T = 250.0 |
---|
4782 | C |
---|
4783 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4784 | DATA (GA( 6,11,IC),IC=1,3) / |
---|
4785 | S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/ |
---|
4786 | DATA (GB( 6,11,IC),IC=1,3) / |
---|
4787 | S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/ |
---|
4788 | DATA (GA( 6,12,IC),IC=1,3) / |
---|
4789 | S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/ |
---|
4790 | DATA (GB( 6,12,IC),IC=1,3) / |
---|
4791 | S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/ |
---|
4792 | C |
---|
4793 | C----- INTERVAL = 6 ----- T = 262.5 |
---|
4794 | C |
---|
4795 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4796 | DATA (GA( 7,11,IC),IC=1,3) / |
---|
4797 | S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/ |
---|
4798 | DATA (GB( 7,11,IC),IC=1,3) / |
---|
4799 | S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/ |
---|
4800 | DATA (GA( 7,12,IC),IC=1,3) / |
---|
4801 | S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/ |
---|
4802 | DATA (GB( 7,12,IC),IC=1,3) / |
---|
4803 | S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/ |
---|
4804 | C |
---|
4805 | C----- INTERVAL = 6 ----- T = 275.0 |
---|
4806 | C |
---|
4807 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4808 | DATA (GA( 8,11,IC),IC=1,3) / |
---|
4809 | S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/ |
---|
4810 | DATA (GB( 8,11,IC),IC=1,3) / |
---|
4811 | S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/ |
---|
4812 | DATA (GA( 8,12,IC),IC=1,3) / |
---|
4813 | S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/ |
---|
4814 | DATA (GB( 8,12,IC),IC=1,3) / |
---|
4815 | S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/ |
---|
4816 | C |
---|
4817 | C----- INTERVAL = 6 ----- T = 287.5 |
---|
4818 | C |
---|
4819 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4820 | DATA (GA( 9,11,IC),IC=1,3) / |
---|
4821 | S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/ |
---|
4822 | DATA (GB( 9,11,IC),IC=1,3) / |
---|
4823 | S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/ |
---|
4824 | DATA (GA( 9,12,IC),IC=1,3) / |
---|
4825 | S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/ |
---|
4826 | DATA (GB( 9,12,IC),IC=1,3) / |
---|
4827 | S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/ |
---|
4828 | C |
---|
4829 | C----- INTERVAL = 6 ----- T = 300.0 |
---|
4830 | C |
---|
4831 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4832 | DATA (GA(10,11,IC),IC=1,3) / |
---|
4833 | S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/ |
---|
4834 | DATA (GB(10,11,IC),IC=1,3) / |
---|
4835 | S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/ |
---|
4836 | DATA (GA(10,12,IC),IC=1,3) / |
---|
4837 | S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/ |
---|
4838 | DATA (GB(10,12,IC),IC=1,3) / |
---|
4839 | S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/ |
---|
4840 | C |
---|
4841 | C----- INTERVAL = 6 ----- T = 312.5 |
---|
4842 | C |
---|
4843 | C-- INDICES FOR PADE APPROXIMATION 1 35 40 45 |
---|
4844 | DATA (GA(11,11,IC),IC=1,3) / |
---|
4845 | S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/ |
---|
4846 | DATA (GB(11,11,IC),IC=1,3) / |
---|
4847 | S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/ |
---|
4848 | DATA (GA(11,12,IC),IC=1,3) / |
---|
4849 | S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/ |
---|
4850 | DATA (GB(11,12,IC),IC=1,3) / |
---|
4851 | S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/ |
---|
4852 | C |
---|
4853 | C |
---|
4854 | C |
---|
4855 | C |
---|
4856 | C |
---|
4857 | C-- END WATER VAPOR |
---|
4858 | C |
---|
4859 | C |
---|
4860 | C-- CO2 -- INT.2 -- 500-800 CM-1 --- FROM ABS225 ---------------------- |
---|
4861 | C |
---|
4862 | C |
---|
4863 | C |
---|
4864 | C-- FIU = 0.8 + MAX(0.35,(7-IU)*0.9) , X/T, 9 |
---|
4865 | C |
---|
4866 | C----- INTERVAL = 2 ----- T = 187.5 |
---|
4867 | C |
---|
4868 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4869 | DATA (GA( 1,13,IC),IC=1,3) / |
---|
4870 | S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/ |
---|
4871 | DATA (GB( 1,13,IC),IC=1,3) / |
---|
4872 | S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/ |
---|
4873 | DATA (GA( 1,14,IC),IC=1,3) / |
---|
4874 | S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/ |
---|
4875 | DATA (GB( 1,14,IC),IC=1,3) / |
---|
4876 | S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/ |
---|
4877 | C |
---|
4878 | C----- INTERVAL = 2 ----- T = 200.0 |
---|
4879 | C |
---|
4880 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4881 | DATA (GA( 2,13,IC),IC=1,3) / |
---|
4882 | S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/ |
---|
4883 | DATA (GB( 2,13,IC),IC=1,3) / |
---|
4884 | S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/ |
---|
4885 | DATA (GA( 2,14,IC),IC=1,3) / |
---|
4886 | S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/ |
---|
4887 | DATA (GB( 2,14,IC),IC=1,3) / |
---|
4888 | S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/ |
---|
4889 | C |
---|
4890 | C----- INTERVAL = 2 ----- T = 212.5 |
---|
4891 | C |
---|
4892 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4893 | DATA (GA( 3,13,IC),IC=1,3) / |
---|
4894 | S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/ |
---|
4895 | DATA (GB( 3,13,IC),IC=1,3) / |
---|
4896 | S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/ |
---|
4897 | DATA (GA( 3,14,IC),IC=1,3) / |
---|
4898 | S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/ |
---|
4899 | DATA (GB( 3,14,IC),IC=1,3) / |
---|
4900 | S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/ |
---|
4901 | C |
---|
4902 | C----- INTERVAL = 2 ----- T = 225.0 |
---|
4903 | C |
---|
4904 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4905 | DATA (GA( 4,13,IC),IC=1,3) / |
---|
4906 | S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/ |
---|
4907 | DATA (GB( 4,13,IC),IC=1,3) / |
---|
4908 | S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/ |
---|
4909 | DATA (GA( 4,14,IC),IC=1,3) / |
---|
4910 | S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/ |
---|
4911 | DATA (GB( 4,14,IC),IC=1,3) / |
---|
4912 | S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/ |
---|
4913 | C |
---|
4914 | C----- INTERVAL = 2 ----- T = 237.5 |
---|
4915 | C |
---|
4916 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4917 | DATA (GA( 5,13,IC),IC=1,3) / |
---|
4918 | S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/ |
---|
4919 | DATA (GB( 5,13,IC),IC=1,3) / |
---|
4920 | S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/ |
---|
4921 | DATA (GA( 5,14,IC),IC=1,3) / |
---|
4922 | S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/ |
---|
4923 | DATA (GB( 5,14,IC),IC=1,3) / |
---|
4924 | S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/ |
---|
4925 | C |
---|
4926 | C----- INTERVAL = 2 ----- T = 250.0 |
---|
4927 | C |
---|
4928 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4929 | DATA (GA( 6,13,IC),IC=1,3) / |
---|
4930 | S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/ |
---|
4931 | DATA (GB( 6,13,IC),IC=1,3) / |
---|
4932 | S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/ |
---|
4933 | DATA (GA( 6,14,IC),IC=1,3) / |
---|
4934 | S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/ |
---|
4935 | DATA (GB( 6,14,IC),IC=1,3) / |
---|
4936 | S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/ |
---|
4937 | C |
---|
4938 | C----- INTERVAL = 2 ----- T = 262.5 |
---|
4939 | C |
---|
4940 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4941 | DATA (GA( 7,13,IC),IC=1,3) / |
---|
4942 | S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/ |
---|
4943 | DATA (GB( 7,13,IC),IC=1,3) / |
---|
4944 | S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/ |
---|
4945 | DATA (GA( 7,14,IC),IC=1,3) / |
---|
4946 | S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/ |
---|
4947 | DATA (GB( 7,14,IC),IC=1,3) / |
---|
4948 | S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/ |
---|
4949 | C |
---|
4950 | C----- INTERVAL = 2 ----- T = 275.0 |
---|
4951 | C |
---|
4952 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4953 | DATA (GA( 8,13,IC),IC=1,3) / |
---|
4954 | S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/ |
---|
4955 | DATA (GB( 8,13,IC),IC=1,3) / |
---|
4956 | S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/ |
---|
4957 | DATA (GA( 8,14,IC),IC=1,3) / |
---|
4958 | S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/ |
---|
4959 | DATA (GB( 8,14,IC),IC=1,3) / |
---|
4960 | S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/ |
---|
4961 | C |
---|
4962 | C----- INTERVAL = 2 ----- T = 287.5 |
---|
4963 | C |
---|
4964 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4965 | DATA (GA( 9,13,IC),IC=1,3) / |
---|
4966 | S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/ |
---|
4967 | DATA (GB( 9,13,IC),IC=1,3) / |
---|
4968 | S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/ |
---|
4969 | DATA (GA( 9,14,IC),IC=1,3) / |
---|
4970 | S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/ |
---|
4971 | DATA (GB( 9,14,IC),IC=1,3) / |
---|
4972 | S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/ |
---|
4973 | C |
---|
4974 | C----- INTERVAL = 2 ----- T = 300.0 |
---|
4975 | C |
---|
4976 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4977 | DATA (GA(10,13,IC),IC=1,3) / |
---|
4978 | S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/ |
---|
4979 | DATA (GB(10,13,IC),IC=1,3) / |
---|
4980 | S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/ |
---|
4981 | DATA (GA(10,14,IC),IC=1,3) / |
---|
4982 | S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/ |
---|
4983 | DATA (GB(10,14,IC),IC=1,3) / |
---|
4984 | S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/ |
---|
4985 | C |
---|
4986 | C----- INTERVAL = 2 ----- T = 312.5 |
---|
4987 | C |
---|
4988 | C-- INDICES FOR PADE APPROXIMATION 1 30 38 45 |
---|
4989 | DATA (GA(11,13,IC),IC=1,3) / |
---|
4990 | S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/ |
---|
4991 | DATA (GB(11,13,IC),IC=1,3) / |
---|
4992 | S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/ |
---|
4993 | DATA (GA(11,14,IC),IC=1,3) / |
---|
4994 | S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/ |
---|
4995 | DATA (GB(11,14,IC),IC=1,3) / |
---|
4996 | S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/ |
---|
4997 | C |
---|
4998 | C |
---|
4999 | C |
---|
5000 | C |
---|
5001 | C |
---|
5002 | C |
---|
5003 | C |
---|
5004 | C |
---|
5005 | C |
---|
5006 | C |
---|
5007 | C-- CARBON DIOXIDE LINES IN THE WINDOW REGION (800-1250 CM-1) |
---|
5008 | C |
---|
5009 | C |
---|
5010 | C-- G = 0.0 |
---|
5011 | C |
---|
5012 | C |
---|
5013 | C----- INTERVAL = 4 ----- T = 187.5 |
---|
5014 | C |
---|
5015 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5016 | DATA (GA( 1,15,IC),IC=1,3) / |
---|
5017 | S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/ |
---|
5018 | DATA (GB( 1,15,IC),IC=1,3) / |
---|
5019 | S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/ |
---|
5020 | DATA (GA( 1,16,IC),IC=1,3) / |
---|
5021 | S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/ |
---|
5022 | DATA (GB( 1,16,IC),IC=1,3) / |
---|
5023 | S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/ |
---|
5024 | C |
---|
5025 | C----- INTERVAL = 4 ----- T = 200.0 |
---|
5026 | C |
---|
5027 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5028 | DATA (GA( 2,15,IC),IC=1,3) / |
---|
5029 | S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/ |
---|
5030 | DATA (GB( 2,15,IC),IC=1,3) / |
---|
5031 | S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/ |
---|
5032 | DATA (GA( 2,16,IC),IC=1,3) / |
---|
5033 | S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/ |
---|
5034 | DATA (GB( 2,16,IC),IC=1,3) / |
---|
5035 | S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/ |
---|
5036 | C |
---|
5037 | C----- INTERVAL = 4 ----- T = 212.5 |
---|
5038 | C |
---|
5039 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5040 | DATA (GA( 3,15,IC),IC=1,3) / |
---|
5041 | S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/ |
---|
5042 | DATA (GB( 3,15,IC),IC=1,3) / |
---|
5043 | S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/ |
---|
5044 | DATA (GA( 3,16,IC),IC=1,3) / |
---|
5045 | S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/ |
---|
5046 | DATA (GB( 3,16,IC),IC=1,3) / |
---|
5047 | S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/ |
---|
5048 | C |
---|
5049 | C----- INTERVAL = 4 ----- T = 225.0 |
---|
5050 | C |
---|
5051 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5052 | DATA (GA( 4,15,IC),IC=1,3) / |
---|
5053 | S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/ |
---|
5054 | DATA (GB( 4,15,IC),IC=1,3) / |
---|
5055 | S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/ |
---|
5056 | DATA (GA( 4,16,IC),IC=1,3) / |
---|
5057 | S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/ |
---|
5058 | DATA (GB( 4,16,IC),IC=1,3) / |
---|
5059 | S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/ |
---|
5060 | C |
---|
5061 | C----- INTERVAL = 4 ----- T = 237.5 |
---|
5062 | C |
---|
5063 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5064 | DATA (GA( 5,15,IC),IC=1,3) / |
---|
5065 | S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/ |
---|
5066 | DATA (GB( 5,15,IC),IC=1,3) / |
---|
5067 | S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/ |
---|
5068 | DATA (GA( 5,16,IC),IC=1,3) / |
---|
5069 | S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/ |
---|
5070 | DATA (GB( 5,16,IC),IC=1,3) / |
---|
5071 | S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/ |
---|
5072 | C |
---|
5073 | C----- INTERVAL = 4 ----- T = 250.0 |
---|
5074 | C |
---|
5075 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5076 | DATA (GA( 6,15,IC),IC=1,3) / |
---|
5077 | S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/ |
---|
5078 | DATA (GB( 6,15,IC),IC=1,3) / |
---|
5079 | S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/ |
---|
5080 | DATA (GA( 6,16,IC),IC=1,3) / |
---|
5081 | S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/ |
---|
5082 | DATA (GB( 6,16,IC),IC=1,3) / |
---|
5083 | S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/ |
---|
5084 | C |
---|
5085 | C----- INTERVAL = 4 ----- T = 262.5 |
---|
5086 | C |
---|
5087 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5088 | DATA (GA( 7,15,IC),IC=1,3) / |
---|
5089 | S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/ |
---|
5090 | DATA (GB( 7,15,IC),IC=1,3) / |
---|
5091 | S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/ |
---|
5092 | DATA (GA( 7,16,IC),IC=1,3) / |
---|
5093 | S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/ |
---|
5094 | DATA (GB( 7,16,IC),IC=1,3) / |
---|
5095 | S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/ |
---|
5096 | C |
---|
5097 | C----- INTERVAL = 4 ----- T = 275.0 |
---|
5098 | C |
---|
5099 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5100 | DATA (GA( 8,15,IC),IC=1,3) / |
---|
5101 | S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/ |
---|
5102 | DATA (GB( 8,15,IC),IC=1,3) / |
---|
5103 | S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/ |
---|
5104 | DATA (GA( 8,16,IC),IC=1,3) / |
---|
5105 | S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/ |
---|
5106 | DATA (GB( 8,16,IC),IC=1,3) / |
---|
5107 | S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/ |
---|
5108 | C |
---|
5109 | C----- INTERVAL = 4 ----- T = 287.5 |
---|
5110 | C |
---|
5111 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5112 | DATA (GA( 9,15,IC),IC=1,3) / |
---|
5113 | S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/ |
---|
5114 | DATA (GB( 9,15,IC),IC=1,3) / |
---|
5115 | S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/ |
---|
5116 | DATA (GA( 9,16,IC),IC=1,3) / |
---|
5117 | S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/ |
---|
5118 | DATA (GB( 9,16,IC),IC=1,3) / |
---|
5119 | S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/ |
---|
5120 | C |
---|
5121 | C----- INTERVAL = 4 ----- T = 300.0 |
---|
5122 | C |
---|
5123 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5124 | DATA (GA(10,15,IC),IC=1,3) / |
---|
5125 | S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/ |
---|
5126 | DATA (GB(10,15,IC),IC=1,3) / |
---|
5127 | S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/ |
---|
5128 | DATA (GA(10,16,IC),IC=1,3) / |
---|
5129 | S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/ |
---|
5130 | DATA (GB(10,16,IC),IC=1,3) / |
---|
5131 | S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/ |
---|
5132 | C |
---|
5133 | C----- INTERVAL = 4 ----- T = 312.5 |
---|
5134 | C |
---|
5135 | C-- INDICES FOR PADE APPROXIMATION 1 15 29 45 |
---|
5136 | DATA (GA(11,15,IC),IC=1,3) / |
---|
5137 | S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/ |
---|
5138 | DATA (GB(11,15,IC),IC=1,3) / |
---|
5139 | S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/ |
---|
5140 | DATA (GA(11,16,IC),IC=1,3) / |
---|
5141 | S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/ |
---|
5142 | DATA (GB(11,16,IC),IC=1,3) / |
---|
5143 | S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/ |
---|
5144 | |
---|
5145 | C ------------------------------------------------------------------ |
---|
5146 | DATA (( XP( J,K),J=1,6), K=1,6) / |
---|
5147 | S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03, |
---|
5148 | S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03, |
---|
5149 | S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03, |
---|
5150 | S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02, |
---|
5151 | S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03, |
---|
5152 | S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02, |
---|
5153 | S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03, |
---|
5154 | S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02, |
---|
5155 | S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02, |
---|
5156 | S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01, |
---|
5157 | S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03, |
---|
5158 | S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 / |
---|
5159 | C |
---|
5160 | C |
---|
5161 | C* 1.0 PLANCK FUNCTIONS AND GRADIENTS |
---|
5162 | C ------------------------------ |
---|
5163 | C |
---|
5164 | 100 CONTINUE |
---|
5165 | C |
---|
5166 | DO 102 JK = 1 , KFLEV+1 |
---|
5167 | DO 101 JL = 1, KDLON |
---|
5168 | PBINT(JL,JK) = 0. |
---|
5169 | 101 CONTINUE |
---|
5170 | 102 CONTINUE |
---|
5171 | DO 103 JL = 1, KDLON |
---|
5172 | PBSUIN(JL) = 0. |
---|
5173 | 103 CONTINUE |
---|
5174 | C |
---|
5175 | DO 141 JNU=1,Ninter |
---|
5176 | C |
---|
5177 | C |
---|
5178 | C* 1.1 LEVELS FROM SURFACE TO KFLEV |
---|
5179 | C ---------------------------- |
---|
5180 | C |
---|
5181 | 110 CONTINUE |
---|
5182 | C |
---|
5183 | DO 112 JK = 1 , KFLEV |
---|
5184 | DO 111 JL = 1, KDLON |
---|
5185 | ZTI(JL)=(PTL(JL,JK)-TSTAND)/TSTAND |
---|
5186 | ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU) |
---|
5187 | S +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU) |
---|
5188 | S ))))) |
---|
5189 | PBINT(JL,JK)=PBINT(JL,JK)+ZRES(JL) |
---|
5190 | PB(JL,JNU,JK)= ZRES(JL) |
---|
5191 | ZBLEV(JL,JK) = ZRES(JL) |
---|
5192 | ZTI2(JL)=(PTAVE(JL,JK)-TSTAND)/TSTAND |
---|
5193 | ZRES2(JL)=XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU) |
---|
5194 | S +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU) |
---|
5195 | S ))))) |
---|
5196 | ZBLAY(JL,JK) = ZRES2(JL) |
---|
5197 | 111 CONTINUE |
---|
5198 | 112 CONTINUE |
---|
5199 | C |
---|
5200 | C |
---|
5201 | C* 1.2 TOP OF THE ATMOSPHERE AND SURFACE |
---|
5202 | C --------------------------------- |
---|
5203 | C |
---|
5204 | 120 CONTINUE |
---|
5205 | C |
---|
5206 | DO 121 JL = 1, KDLON |
---|
5207 | ZTI(JL)=(PTL(JL,KFLEV+1)-TSTAND)/TSTAND |
---|
5208 | ZTI2(JL) = (PTL(JL,1) + PDT0(JL) - TSTAND) / TSTAND |
---|
5209 | ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU) |
---|
5210 | S +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU) |
---|
5211 | S ))))) |
---|
5212 | ZRES2(JL) = XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU) |
---|
5213 | S +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU) |
---|
5214 | S ))))) |
---|
5215 | PBINT(JL,KFLEV+1) = PBINT(JL,KFLEV+1)+ZRES(JL) |
---|
5216 | PB(JL,JNU,KFLEV+1)= ZRES(JL) |
---|
5217 | ZBLEV(JL,KFLEV+1) = ZRES(JL) |
---|
5218 | PBTOP(JL,JNU) = ZRES(JL) |
---|
5219 | PBSUR(JL,JNU) = ZRES2(JL) |
---|
5220 | PBSUIN(JL) = PBSUIN(JL) + ZRES2(JL) |
---|
5221 | 121 CONTINUE |
---|
5222 | C |
---|
5223 | C |
---|
5224 | C* 1.3 GRADIENTS IN SUB-LAYERS |
---|
5225 | C ----------------------- |
---|
5226 | C |
---|
5227 | 130 CONTINUE |
---|
5228 | C |
---|
5229 | DO 132 JK = 1 , KFLEV |
---|
5230 | JK2 = 2 * JK |
---|
5231 | JK1 = JK2 - 1 |
---|
5232 | DO 131 JL = 1, KDLON |
---|
5233 | PDBSL(JL,JNU,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK) |
---|
5234 | PDBSL(JL,JNU,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK) |
---|
5235 | 131 CONTINUE |
---|
5236 | 132 CONTINUE |
---|
5237 | C |
---|
5238 | 141 CONTINUE |
---|
5239 | C |
---|
5240 | C* 2.0 CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS |
---|
5241 | C --------------------------------------------- |
---|
5242 | C |
---|
5243 | 200 CONTINUE |
---|
5244 | C |
---|
5245 | C |
---|
5246 | 210 CONTINUE |
---|
5247 | C |
---|
5248 | DO 211 JL=1, KDLON |
---|
5249 | ZDSTO1 = (PTL(JL,KFLEV+1)-TINTP(1)) / TSTP |
---|
5250 | IXTOX = MAX( 1, MIN( MXIXT, INT( ZDSTO1 + 1. ) ) ) |
---|
5251 | ZDSTOX = (PTL(JL,KFLEV+1)-TINTP(IXTOX))/TSTP |
---|
5252 | IF (ZDSTOX.LT.0.5) THEN |
---|
5253 | INDTO=IXTOX |
---|
5254 | ELSE |
---|
5255 | INDTO=IXTOX+1 |
---|
5256 | END IF |
---|
5257 | INDB(JL)=INDTO |
---|
5258 | ZDST1 = (PTL(JL,1)-TINTP(1)) / TSTP |
---|
5259 | IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) ) |
---|
5260 | ZDSTX = (PTL(JL,1)-TINTP(IXTX))/TSTP |
---|
5261 | IF (ZDSTX.LT.0.5) THEN |
---|
5262 | INDT=IXTX |
---|
5263 | ELSE |
---|
5264 | INDT=IXTX+1 |
---|
5265 | END IF |
---|
5266 | INDS(JL)=INDT |
---|
5267 | 211 CONTINUE |
---|
5268 | C |
---|
5269 | DO 214 JF=1,2 |
---|
5270 | DO 213 JG=1, 8 |
---|
5271 | DO 212 JL=1, KDLON |
---|
5272 | INDSU=INDS(JL) |
---|
5273 | PGASUR(JL,JG,JF)=GA(INDSU,2*JG-1,JF) |
---|
5274 | PGBSUR(JL,JG,JF)=GB(INDSU,2*JG-1,JF) |
---|
5275 | INDTP=INDB(JL) |
---|
5276 | PGATOP(JL,JG,JF)=GA(INDTP,2*JG-1,JF) |
---|
5277 | PGBTOP(JL,JG,JF)=GB(INDTP,2*JG-1,JF) |
---|
5278 | 212 CONTINUE |
---|
5279 | 213 CONTINUE |
---|
5280 | 214 CONTINUE |
---|
5281 | C |
---|
5282 | 220 CONTINUE |
---|
5283 | C |
---|
5284 | DO 225 JK=1,KFLEV |
---|
5285 | DO 221 JL=1, KDLON |
---|
5286 | ZDST1 = (PTAVE(JL,JK)-TINTP(1)) / TSTP |
---|
5287 | IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) ) |
---|
5288 | ZDSTX = (PTAVE(JL,JK)-TINTP(IXTX))/TSTP |
---|
5289 | IF (ZDSTX.LT.0.5) THEN |
---|
5290 | INDT=IXTX |
---|
5291 | ELSE |
---|
5292 | INDT=IXTX+1 |
---|
5293 | END IF |
---|
5294 | INDB(JL)=INDT |
---|
5295 | 221 CONTINUE |
---|
5296 | C |
---|
5297 | DO 224 JF=1,2 |
---|
5298 | DO 223 JG=1, 8 |
---|
5299 | DO 222 JL=1, KDLON |
---|
5300 | INDT=INDB(JL) |
---|
5301 | PGA(JL,JG,JF,JK)=GA(INDT,2*JG,JF) |
---|
5302 | PGB(JL,JG,JF,JK)=GB(INDT,2*JG,JF) |
---|
5303 | 222 CONTINUE |
---|
5304 | 223 CONTINUE |
---|
5305 | 224 CONTINUE |
---|
5306 | 225 CONTINUE |
---|
5307 | C |
---|
5308 | C ------------------------------------------------------------------ |
---|
5309 | C |
---|
5310 | RETURN |
---|
5311 | END |
---|
5312 | SUBROUTINE LWV(KUAER,KTRAER, KLIM |
---|
5313 | R , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE |
---|
5314 | R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
---|
5315 | S , PCNTRB,PCTS,PFLUC) |
---|
5316 | USE dimphy |
---|
5317 | IMPLICIT none |
---|
5318 | cym#include "dimensions.h" |
---|
5319 | cym#include "dimphy.h" |
---|
5320 | cym#include "raddim.h" |
---|
5321 | #include "raddimlw.h" |
---|
5322 | #include "YOMCST.h" |
---|
5323 | C |
---|
5324 | C----------------------------------------------------------------------- |
---|
5325 | C PURPOSE. |
---|
5326 | C -------- |
---|
5327 | C CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE |
---|
5328 | C FLUXES OR RADIANCES |
---|
5329 | C |
---|
5330 | C METHOD. |
---|
5331 | C ------- |
---|
5332 | C |
---|
5333 | C 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN |
---|
5334 | C CONTRIBUTIONS BY - THE NEARBY LAYERS |
---|
5335 | C - THE DISTANT LAYERS |
---|
5336 | C - THE BOUNDARY TERMS |
---|
5337 | C 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. |
---|
5338 | C |
---|
5339 | C REFERENCE. |
---|
5340 | C ---------- |
---|
5341 | C |
---|
5342 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
5343 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
5344 | C |
---|
5345 | C AUTHOR. |
---|
5346 | C ------- |
---|
5347 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
5348 | C |
---|
5349 | C MODIFICATIONS. |
---|
5350 | C -------------- |
---|
5351 | C ORIGINAL : 89-07-14 |
---|
5352 | C----------------------------------------------------------------------- |
---|
5353 | C |
---|
5354 | C* ARGUMENTS: |
---|
5355 | INTEGER KUAER,KTRAER, KLIM |
---|
5356 | C |
---|
5357 | REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS |
---|
5358 | REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS |
---|
5359 | REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS |
---|
5360 | REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION |
---|
5361 | REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
---|
5362 | REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION |
---|
5363 | REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
---|
5364 | REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
---|
5365 | REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB) |
---|
5366 | REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE |
---|
5367 | REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
5368 | REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
5369 | REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS |
---|
5370 | REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS |
---|
5371 | REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS |
---|
5372 | REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS |
---|
5373 | C |
---|
5374 | REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX |
---|
5375 | REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM |
---|
5376 | REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
---|
5377 | C----------------------------------------------------------------------- |
---|
5378 | C LOCAL VARIABLES: |
---|
5379 | REAL*8 ZADJD(KDLON,KFLEV+1) |
---|
5380 | REAL*8 ZADJU(KDLON,KFLEV+1) |
---|
5381 | REAL*8 ZDBDT(KDLON,Ninter,KFLEV) |
---|
5382 | REAL*8 ZDISD(KDLON,KFLEV+1) |
---|
5383 | REAL*8 ZDISU(KDLON,KFLEV+1) |
---|
5384 | C |
---|
5385 | INTEGER jk, jl |
---|
5386 | C----------------------------------------------------------------------- |
---|
5387 | C |
---|
5388 | DO 112 JK=1,KFLEV+1 |
---|
5389 | DO 111 JL=1, KDLON |
---|
5390 | ZADJD(JL,JK)=0. |
---|
5391 | ZADJU(JL,JK)=0. |
---|
5392 | ZDISD(JL,JK)=0. |
---|
5393 | ZDISU(JL,JK)=0. |
---|
5394 | 111 CONTINUE |
---|
5395 | 112 CONTINUE |
---|
5396 | C |
---|
5397 | DO 114 JK=1,KFLEV |
---|
5398 | DO 113 JL=1, KDLON |
---|
5399 | PCTS(JL,JK)=0. |
---|
5400 | 113 CONTINUE |
---|
5401 | 114 CONTINUE |
---|
5402 | C |
---|
5403 | C* CONTRIBUTION FROM ADJACENT LAYERS |
---|
5404 | C |
---|
5405 | CALL LWVN(KUAER,KTRAER |
---|
5406 | R , PABCU,PDBSL,PGA,PGB |
---|
5407 | S , ZADJD,ZADJU,PCNTRB,ZDBDT) |
---|
5408 | C* CONTRIBUTION FROM DISTANT LAYERS |
---|
5409 | C |
---|
5410 | CALL LWVD(KUAER,KTRAER |
---|
5411 | R , PABCU,ZDBDT,PGA,PGB |
---|
5412 | S , PCNTRB,ZDISD,ZDISU) |
---|
5413 | C |
---|
5414 | C* EXCHANGE WITH THE BOUNDARIES |
---|
5415 | C |
---|
5416 | CALL LWVB(KUAER,KTRAER, KLIM |
---|
5417 | R , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP |
---|
5418 | R , ZDISD,ZDISU,PEMIS,PPMB |
---|
5419 | R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
---|
5420 | S , PCTS,PFLUC) |
---|
5421 | C |
---|
5422 | C |
---|
5423 | RETURN |
---|
5424 | END |
---|
5425 | SUBROUTINE LWVB(KUAER,KTRAER, KLIM |
---|
5426 | R , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP |
---|
5427 | R , PDISD,PDISU,PEMIS,PPMB |
---|
5428 | R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
---|
5429 | S , PCTS,PFLUC) |
---|
5430 | USE dimphy |
---|
5431 | IMPLICIT none |
---|
5432 | cym#include "dimensions.h" |
---|
5433 | cym#include "dimphy.h" |
---|
5434 | cym#include "raddim.h" |
---|
5435 | #include "raddimlw.h" |
---|
5436 | #include "radopt.h" |
---|
5437 | C |
---|
5438 | C----------------------------------------------------------------------- |
---|
5439 | C PURPOSE. |
---|
5440 | C -------- |
---|
5441 | C INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL |
---|
5442 | C INTEGRATION |
---|
5443 | C |
---|
5444 | C METHOD. |
---|
5445 | C ------- |
---|
5446 | C |
---|
5447 | C 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE |
---|
5448 | C ATMOSPHERE |
---|
5449 | C 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND |
---|
5450 | C TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA |
---|
5451 | C 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES |
---|
5452 | C |
---|
5453 | C REFERENCE. |
---|
5454 | C ---------- |
---|
5455 | C |
---|
5456 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
5457 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
5458 | C |
---|
5459 | C AUTHOR. |
---|
5460 | C ------- |
---|
5461 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
5462 | C |
---|
5463 | C MODIFICATIONS. |
---|
5464 | C -------------- |
---|
5465 | C ORIGINAL : 89-07-14 |
---|
5466 | C Voigt lines (loop 2413 to 2427) - JJM & PhD - 01/96 |
---|
5467 | C----------------------------------------------------------------------- |
---|
5468 | C |
---|
5469 | C* 0.1 ARGUMENTS |
---|
5470 | C --------- |
---|
5471 | C |
---|
5472 | INTEGER KUAER,KTRAER, KLIM |
---|
5473 | C |
---|
5474 | REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS |
---|
5475 | REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS |
---|
5476 | REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS |
---|
5477 | REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS |
---|
5478 | REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS |
---|
5479 | REAL*8 PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION |
---|
5480 | REAL*8 PBSUI(KDLON) ! SURFACE PLANCK FUNCTION |
---|
5481 | REAL*8 PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION |
---|
5482 | REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
---|
5483 | REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
---|
5484 | REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
---|
5485 | REAL*8 PPMB(KDLON,KFLEV+1) ! PRESSURE MB |
---|
5486 | REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
5487 | REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
5488 | REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
---|
5489 | REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS |
---|
5490 | REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
---|
5491 | REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS |
---|
5492 | C |
---|
5493 | REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
---|
5494 | REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM |
---|
5495 | C |
---|
5496 | C* LOCAL VARIABLES: |
---|
5497 | C |
---|
5498 | REAL*8 ZBGND(KDLON) |
---|
5499 | REAL*8 ZFD(KDLON) |
---|
5500 | REAL*8 ZFN10(KDLON) |
---|
5501 | REAL*8 ZFU(KDLON) |
---|
5502 | REAL*8 ZTT(KDLON,NTRA) |
---|
5503 | REAL*8 ZTT1(KDLON,NTRA) |
---|
5504 | REAL*8 ZTT2(KDLON,NTRA) |
---|
5505 | REAL*8 ZUU(KDLON,NUA) |
---|
5506 | REAL*8 ZCNSOL(KDLON) |
---|
5507 | REAL*8 ZCNTOP(KDLON) |
---|
5508 | C |
---|
5509 | INTEGER jk, jl, ja |
---|
5510 | INTEGER jstra, jstru |
---|
5511 | INTEGER ind1, ind2, ind3, ind4, in, jlim |
---|
5512 | REAL*8 zctstr |
---|
5513 | C----------------------------------------------------------------------- |
---|
5514 | C |
---|
5515 | C* 1. INITIALIZATION |
---|
5516 | C -------------- |
---|
5517 | C |
---|
5518 | 100 CONTINUE |
---|
5519 | C |
---|
5520 | C |
---|
5521 | C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
---|
5522 | C --------------------------------- |
---|
5523 | C |
---|
5524 | 120 CONTINUE |
---|
5525 | C |
---|
5526 | DO 122 JA=1,NTRA |
---|
5527 | DO 121 JL=1, KDLON |
---|
5528 | ZTT (JL,JA)=1.0 |
---|
5529 | ZTT1(JL,JA)=1.0 |
---|
5530 | ZTT2(JL,JA)=1.0 |
---|
5531 | 121 CONTINUE |
---|
5532 | 122 CONTINUE |
---|
5533 | C |
---|
5534 | DO 124 JA=1,NUA |
---|
5535 | DO 123 JL=1, KDLON |
---|
5536 | ZUU(JL,JA)=1.0 |
---|
5537 | 123 CONTINUE |
---|
5538 | 124 CONTINUE |
---|
5539 | C |
---|
5540 | C ------------------------------------------------------------------ |
---|
5541 | C |
---|
5542 | C* 2. VERTICAL INTEGRATION |
---|
5543 | C -------------------- |
---|
5544 | C |
---|
5545 | 200 CONTINUE |
---|
5546 | C |
---|
5547 | IND1=0 |
---|
5548 | IND3=0 |
---|
5549 | IND4=1 |
---|
5550 | IND2=1 |
---|
5551 | C |
---|
5552 | C |
---|
5553 | C* 2.3 EXCHANGE WITH TOP OF THE ATMOSPHERE |
---|
5554 | C ----------------------------------- |
---|
5555 | C |
---|
5556 | 230 CONTINUE |
---|
5557 | C |
---|
5558 | DO 235 JK = 1 , KFLEV |
---|
5559 | IN=(JK-1)*NG1P1+1 |
---|
5560 | C |
---|
5561 | DO 232 JA=1,KUAER |
---|
5562 | DO 231 JL=1, KDLON |
---|
5563 | ZUU(JL,JA)=PABCU(JL,JA,IN) |
---|
5564 | 231 CONTINUE |
---|
5565 | 232 CONTINUE |
---|
5566 | C |
---|
5567 | C |
---|
5568 | CALL LWTT(PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT) |
---|
5569 | C |
---|
5570 | DO 234 JL = 1, KDLON |
---|
5571 | ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1) *ZTT(JL,10) |
---|
5572 | 2 +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
---|
5573 | 3 +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
---|
5574 | 4 +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
---|
5575 | 5 +PBTOP(JL,5)*ZTT(JL,3) *ZTT(JL,14) |
---|
5576 | 6 +PBTOP(JL,6)*ZTT(JL,6) *ZTT(JL,15) |
---|
5577 | ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK) |
---|
5578 | PFLUC(JL,2,JK)=ZFD(JL) |
---|
5579 | 234 CONTINUE |
---|
5580 | C |
---|
5581 | 235 CONTINUE |
---|
5582 | C |
---|
5583 | JK = KFLEV+1 |
---|
5584 | IN=(JK-1)*NG1P1+1 |
---|
5585 | C |
---|
5586 | DO 236 JL = 1, KDLON |
---|
5587 | ZCNTOP(JL)= PBTOP(JL,1) |
---|
5588 | 1 + PBTOP(JL,2) |
---|
5589 | 2 + PBTOP(JL,3) |
---|
5590 | 3 + PBTOP(JL,4) |
---|
5591 | 4 + PBTOP(JL,5) |
---|
5592 | 5 + PBTOP(JL,6) |
---|
5593 | ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK) |
---|
5594 | PFLUC(JL,2,JK)=ZFD(JL) |
---|
5595 | 236 CONTINUE |
---|
5596 | C |
---|
5597 | C* 2.4 COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA |
---|
5598 | C --------------------------------------- |
---|
5599 | C |
---|
5600 | 240 CONTINUE |
---|
5601 | C |
---|
5602 | C |
---|
5603 | C* 2.4.1 INITIALIZATION |
---|
5604 | C -------------- |
---|
5605 | C |
---|
5606 | 2410 CONTINUE |
---|
5607 | C |
---|
5608 | JLIM = KFLEV |
---|
5609 | C |
---|
5610 | IF (.NOT.LEVOIGT) THEN |
---|
5611 | DO 2412 JK = KFLEV,1,-1 |
---|
5612 | IF(PPMB(1,JK).LT.10.0) THEN |
---|
5613 | JLIM=JK |
---|
5614 | ENDIF |
---|
5615 | 2412 CONTINUE |
---|
5616 | ENDIF |
---|
5617 | KLIM=JLIM |
---|
5618 | C |
---|
5619 | IF (.NOT.LEVOIGT) THEN |
---|
5620 | DO 2414 JA=1,KTRAER |
---|
5621 | DO 2413 JL=1, KDLON |
---|
5622 | ZTT1(JL,JA)=1.0 |
---|
5623 | 2413 CONTINUE |
---|
5624 | 2414 CONTINUE |
---|
5625 | C |
---|
5626 | C* 2.4.2 LOOP OVER LAYERS ABOVE 10 HPA |
---|
5627 | C ----------------------------- |
---|
5628 | C |
---|
5629 | 2420 CONTINUE |
---|
5630 | C |
---|
5631 | DO 2427 JSTRA = KFLEV,JLIM,-1 |
---|
5632 | JSTRU=(JSTRA-1)*NG1P1+1 |
---|
5633 | C |
---|
5634 | DO 2423 JA=1,KUAER |
---|
5635 | DO 2422 JL=1, KDLON |
---|
5636 | ZUU(JL,JA)=PABCU(JL,JA,JSTRU) |
---|
5637 | 2422 CONTINUE |
---|
5638 | 2423 CONTINUE |
---|
5639 | C |
---|
5640 | C |
---|
5641 | CALL LWTT(PGA(1,1,1,JSTRA), PGB(1,1,1,JSTRA), ZUU, ZTT) |
---|
5642 | C |
---|
5643 | DO 2424 JL = 1, KDLON |
---|
5644 | ZCTSTR = |
---|
5645 | 1 (PB(JL,1,JSTRA)+PB(JL,1,JSTRA+1)) |
---|
5646 | 1 *(ZTT1(JL,1) *ZTT1(JL,10) |
---|
5647 | 1 - ZTT (JL,1) *ZTT (JL,10)) |
---|
5648 | 2 +(PB(JL,2,JSTRA)+PB(JL,2,JSTRA+1)) |
---|
5649 | 2 *(ZTT1(JL,2)*ZTT1(JL,7)*ZTT1(JL,11) |
---|
5650 | 2 - ZTT (JL,2)*ZTT (JL,7)*ZTT (JL,11)) |
---|
5651 | 3 +(PB(JL,3,JSTRA)+PB(JL,3,JSTRA+1)) |
---|
5652 | 3 *(ZTT1(JL,4)*ZTT1(JL,8)*ZTT1(JL,12) |
---|
5653 | 3 - ZTT (JL,4)*ZTT (JL,8)*ZTT (JL,12)) |
---|
5654 | 4 +(PB(JL,4,JSTRA)+PB(JL,4,JSTRA+1)) |
---|
5655 | 4 *(ZTT1(JL,5)*ZTT1(JL,9)*ZTT1(JL,13) |
---|
5656 | 4 - ZTT (JL,5)*ZTT (JL,9)*ZTT (JL,13)) |
---|
5657 | 5 +(PB(JL,5,JSTRA)+PB(JL,5,JSTRA+1)) |
---|
5658 | 5 *(ZTT1(JL,3) *ZTT1(JL,14) |
---|
5659 | 5 - ZTT (JL,3) *ZTT (JL,14)) |
---|
5660 | 6 +(PB(JL,6,JSTRA)+PB(JL,6,JSTRA+1)) |
---|
5661 | 6 *(ZTT1(JL,6) *ZTT1(JL,15) |
---|
5662 | 6 - ZTT (JL,6) *ZTT (JL,15)) |
---|
5663 | PCTS(JL,JSTRA)=ZCTSTR*0.5 |
---|
5664 | 2424 CONTINUE |
---|
5665 | DO 2426 JA=1,KTRAER |
---|
5666 | DO 2425 JL=1, KDLON |
---|
5667 | ZTT1(JL,JA)=ZTT(JL,JA) |
---|
5668 | 2425 CONTINUE |
---|
5669 | 2426 CONTINUE |
---|
5670 | 2427 CONTINUE |
---|
5671 | ENDIF |
---|
5672 | C Mise a zero de securite pour PCTS en cas de LEVOIGT |
---|
5673 | IF(LEVOIGT)THEN |
---|
5674 | DO 2429 JSTRA = 1,KFLEV |
---|
5675 | DO 2428 JL = 1, KDLON |
---|
5676 | PCTS(JL,JSTRA)=0. |
---|
5677 | 2428 CONTINUE |
---|
5678 | 2429 CONTINUE |
---|
5679 | ENDIF |
---|
5680 | C |
---|
5681 | C |
---|
5682 | C* 2.5 EXCHANGE WITH LOWER LIMIT |
---|
5683 | C ------------------------- |
---|
5684 | C |
---|
5685 | 250 CONTINUE |
---|
5686 | C |
---|
5687 | DO 251 JL = 1, KDLON |
---|
5688 | ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL)) |
---|
5689 | S *PFLUC(JL,2,1)-PBINT(JL,1) |
---|
5690 | 251 CONTINUE |
---|
5691 | C |
---|
5692 | JK = 1 |
---|
5693 | IN=(JK-1)*NG1P1+1 |
---|
5694 | C |
---|
5695 | DO 252 JL = 1, KDLON |
---|
5696 | ZCNSOL(JL)=PBSUR(JL,1) |
---|
5697 | 1 +PBSUR(JL,2) |
---|
5698 | 2 +PBSUR(JL,3) |
---|
5699 | 3 +PBSUR(JL,4) |
---|
5700 | 4 +PBSUR(JL,5) |
---|
5701 | 5 +PBSUR(JL,6) |
---|
5702 | ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL) |
---|
5703 | ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK) |
---|
5704 | PFLUC(JL,1,JK)=ZFU(JL) |
---|
5705 | 252 CONTINUE |
---|
5706 | C |
---|
5707 | DO 257 JK = 2 , KFLEV+1 |
---|
5708 | IN=(JK-1)*NG1P1+1 |
---|
5709 | C |
---|
5710 | C |
---|
5711 | DO 255 JA=1,KUAER |
---|
5712 | DO 254 JL=1, KDLON |
---|
5713 | ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN) |
---|
5714 | 254 CONTINUE |
---|
5715 | 255 CONTINUE |
---|
5716 | C |
---|
5717 | C |
---|
5718 | CALL LWTT(PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT) |
---|
5719 | C |
---|
5720 | DO 256 JL = 1, KDLON |
---|
5721 | ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1) *ZTT(JL,10) |
---|
5722 | 2 +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
---|
5723 | 3 +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
---|
5724 | 4 +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
---|
5725 | 5 +PBSUR(JL,5)*ZTT(JL,3) *ZTT(JL,14) |
---|
5726 | 6 +PBSUR(JL,6)*ZTT(JL,6) *ZTT(JL,15) |
---|
5727 | ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL) |
---|
5728 | ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK) |
---|
5729 | PFLUC(JL,1,JK)=ZFU(JL) |
---|
5730 | 256 CONTINUE |
---|
5731 | C |
---|
5732 | C |
---|
5733 | 257 CONTINUE |
---|
5734 | C |
---|
5735 | C |
---|
5736 | C |
---|
5737 | C* 2.7 CLEAR-SKY FLUXES |
---|
5738 | C ---------------- |
---|
5739 | C |
---|
5740 | 270 CONTINUE |
---|
5741 | C |
---|
5742 | IF (.NOT.LEVOIGT) THEN |
---|
5743 | DO 271 JL = 1, KDLON |
---|
5744 | ZFN10(JL) = PFLUC(JL,1,JLIM) + PFLUC(JL,2,JLIM) |
---|
5745 | 271 CONTINUE |
---|
5746 | DO 273 JK = JLIM+1,KFLEV+1 |
---|
5747 | DO 272 JL = 1, KDLON |
---|
5748 | ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1) |
---|
5749 | PFLUC(JL,1,JK) = ZFN10(JL) |
---|
5750 | PFLUC(JL,2,JK) = 0. |
---|
5751 | 272 CONTINUE |
---|
5752 | 273 CONTINUE |
---|
5753 | ENDIF |
---|
5754 | C |
---|
5755 | C ------------------------------------------------------------------ |
---|
5756 | C |
---|
5757 | RETURN |
---|
5758 | END |
---|
5759 | SUBROUTINE LWVD(KUAER,KTRAER |
---|
5760 | S , PABCU,PDBDT |
---|
5761 | R , PGA,PGB |
---|
5762 | S , PCNTRB,PDISD,PDISU) |
---|
5763 | USE dimphy |
---|
5764 | IMPLICIT none |
---|
5765 | cym#include "dimensions.h" |
---|
5766 | cym#include "dimphy.h" |
---|
5767 | cym#include "raddim.h" |
---|
5768 | #include "raddimlw.h" |
---|
5769 | C |
---|
5770 | C----------------------------------------------------------------------- |
---|
5771 | C PURPOSE. |
---|
5772 | C -------- |
---|
5773 | C CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS |
---|
5774 | C |
---|
5775 | C METHOD. |
---|
5776 | C ------- |
---|
5777 | C |
---|
5778 | C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE |
---|
5779 | C CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE |
---|
5780 | C |
---|
5781 | C REFERENCE. |
---|
5782 | C ---------- |
---|
5783 | C |
---|
5784 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
5785 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
5786 | C |
---|
5787 | C AUTHOR. |
---|
5788 | C ------- |
---|
5789 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
5790 | C |
---|
5791 | C MODIFICATIONS. |
---|
5792 | C -------------- |
---|
5793 | C ORIGINAL : 89-07-14 |
---|
5794 | C----------------------------------------------------------------------- |
---|
5795 | C* ARGUMENTS: |
---|
5796 | C |
---|
5797 | INTEGER KUAER,KTRAER |
---|
5798 | C |
---|
5799 | REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS |
---|
5800 | REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT |
---|
5801 | REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
5802 | REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
5803 | C |
---|
5804 | REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! ENERGY EXCHANGE MATRIX |
---|
5805 | REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
---|
5806 | REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS |
---|
5807 | C |
---|
5808 | C* LOCAL VARIABLES: |
---|
5809 | C |
---|
5810 | REAL*8 ZGLAYD(KDLON) |
---|
5811 | REAL*8 ZGLAYU(KDLON) |
---|
5812 | REAL*8 ZTT(KDLON,NTRA) |
---|
5813 | REAL*8 ZTT1(KDLON,NTRA) |
---|
5814 | REAL*8 ZTT2(KDLON,NTRA) |
---|
5815 | C |
---|
5816 | INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2 |
---|
5817 | INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2 |
---|
5818 | INTEGER ind1, ind2, ind3, ind4, itt |
---|
5819 | REAL*8 zww, zdzxdg, zdzxmg |
---|
5820 | C |
---|
5821 | C* 1. INITIALIZATION |
---|
5822 | C -------------- |
---|
5823 | C |
---|
5824 | 100 CONTINUE |
---|
5825 | C |
---|
5826 | C* 1.1 INITIALIZE LAYER CONTRIBUTIONS |
---|
5827 | C ------------------------------ |
---|
5828 | C |
---|
5829 | 110 CONTINUE |
---|
5830 | C |
---|
5831 | DO 112 JK = 1, KFLEV+1 |
---|
5832 | DO 111 JL = 1, KDLON |
---|
5833 | PDISD(JL,JK) = 0. |
---|
5834 | PDISU(JL,JK) = 0. |
---|
5835 | 111 CONTINUE |
---|
5836 | 112 CONTINUE |
---|
5837 | C |
---|
5838 | C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
---|
5839 | C --------------------------------- |
---|
5840 | C |
---|
5841 | 120 CONTINUE |
---|
5842 | C |
---|
5843 | C |
---|
5844 | DO 122 JA = 1, NTRA |
---|
5845 | DO 121 JL = 1, KDLON |
---|
5846 | ZTT (JL,JA) = 1.0 |
---|
5847 | ZTT1(JL,JA) = 1.0 |
---|
5848 | ZTT2(JL,JA) = 1.0 |
---|
5849 | 121 CONTINUE |
---|
5850 | 122 CONTINUE |
---|
5851 | C |
---|
5852 | C ------------------------------------------------------------------ |
---|
5853 | C |
---|
5854 | C* 2. VERTICAL INTEGRATION |
---|
5855 | C -------------------- |
---|
5856 | C |
---|
5857 | 200 CONTINUE |
---|
5858 | C |
---|
5859 | IND1=0 |
---|
5860 | IND3=0 |
---|
5861 | IND4=1 |
---|
5862 | IND2=1 |
---|
5863 | C |
---|
5864 | C |
---|
5865 | C* 2.2 CONTRIBUTION FROM DISTANT LAYERS |
---|
5866 | C --------------------------------- |
---|
5867 | C |
---|
5868 | 220 CONTINUE |
---|
5869 | C |
---|
5870 | C |
---|
5871 | C* 2.2.1 DISTANT AND ABOVE LAYERS |
---|
5872 | C ------------------------ |
---|
5873 | C |
---|
5874 | 2210 CONTINUE |
---|
5875 | C |
---|
5876 | C |
---|
5877 | C |
---|
5878 | C* 2.2.2 FIRST UPPER LEVEL |
---|
5879 | C ----------------- |
---|
5880 | C |
---|
5881 | 2220 CONTINUE |
---|
5882 | C |
---|
5883 | DO 225 JK = 1 , KFLEV-1 |
---|
5884 | IKP1=JK+1 |
---|
5885 | IKN=(JK-1)*NG1P1+1 |
---|
5886 | IKD1= JK *NG1P1+1 |
---|
5887 | C |
---|
5888 | CALL LWTTM(PGA(1,1,1,JK), PGB(1,1,1,JK) |
---|
5889 | 2 , PABCU(1,1,IKN),PABCU(1,1,IKD1),ZTT1) |
---|
5890 | C |
---|
5891 | C |
---|
5892 | C |
---|
5893 | C* 2.2.3 HIGHER UP |
---|
5894 | C --------- |
---|
5895 | C |
---|
5896 | 2230 CONTINUE |
---|
5897 | C |
---|
5898 | ITT=1 |
---|
5899 | DO 224 JKJ=IKP1,KFLEV |
---|
5900 | IF(ITT.EQ.1) THEN |
---|
5901 | ITT=2 |
---|
5902 | ELSE |
---|
5903 | ITT=1 |
---|
5904 | ENDIF |
---|
5905 | IKJP1=JKJ+1 |
---|
5906 | IKD2= JKJ *NG1P1+1 |
---|
5907 | C |
---|
5908 | IF(ITT.EQ.1) THEN |
---|
5909 | CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ) |
---|
5910 | 2 , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT1) |
---|
5911 | ELSE |
---|
5912 | CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ) |
---|
5913 | 2 , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT2) |
---|
5914 | ENDIF |
---|
5915 | C |
---|
5916 | DO 2235 JA = 1, KTRAER |
---|
5917 | DO 2234 JL = 1, KDLON |
---|
5918 | ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5 |
---|
5919 | 2234 CONTINUE |
---|
5920 | 2235 CONTINUE |
---|
5921 | C |
---|
5922 | DO 2236 JL = 1, KDLON |
---|
5923 | ZWW=PDBDT(JL,1,JKJ)*ZTT(JL,1) *ZTT(JL,10) |
---|
5924 | S +PDBDT(JL,2,JKJ)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
---|
5925 | S +PDBDT(JL,3,JKJ)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
---|
5926 | S +PDBDT(JL,4,JKJ)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
---|
5927 | S +PDBDT(JL,5,JKJ)*ZTT(JL,3) *ZTT(JL,14) |
---|
5928 | S +PDBDT(JL,6,JKJ)*ZTT(JL,6) *ZTT(JL,15) |
---|
5929 | ZGLAYD(JL)=ZWW |
---|
5930 | ZDZXDG=ZGLAYD(JL) |
---|
5931 | PDISD(JL,JK)=PDISD(JL,JK)+ZDZXDG |
---|
5932 | PCNTRB(JL,JK,IKJP1)=ZDZXDG |
---|
5933 | 2236 CONTINUE |
---|
5934 | C |
---|
5935 | C |
---|
5936 | 224 CONTINUE |
---|
5937 | 225 CONTINUE |
---|
5938 | C |
---|
5939 | C |
---|
5940 | C* 2.2.4 DISTANT AND BELOW LAYERS |
---|
5941 | C ------------------------ |
---|
5942 | C |
---|
5943 | 2240 CONTINUE |
---|
5944 | C |
---|
5945 | C |
---|
5946 | C |
---|
5947 | C* 2.2.5 FIRST LOWER LEVEL |
---|
5948 | C ----------------- |
---|
5949 | C |
---|
5950 | 2250 CONTINUE |
---|
5951 | C |
---|
5952 | DO 228 JK=3,KFLEV+1 |
---|
5953 | IKN=(JK-1)*NG1P1+1 |
---|
5954 | IKM1=JK-1 |
---|
5955 | IKJ=JK-2 |
---|
5956 | IKU1= IKJ *NG1P1+1 |
---|
5957 | C |
---|
5958 | C |
---|
5959 | CALL LWTTM(PGA(1,1,1,IKJ),PGB(1,1,1,IKJ) |
---|
5960 | 2 , PABCU(1,1,IKU1),PABCU(1,1,IKN),ZTT1) |
---|
5961 | C |
---|
5962 | C |
---|
5963 | C |
---|
5964 | C* 2.2.6 DOWN BELOW |
---|
5965 | C ---------- |
---|
5966 | C |
---|
5967 | 2260 CONTINUE |
---|
5968 | C |
---|
5969 | ITT=1 |
---|
5970 | DO 227 JLK=1,IKJ |
---|
5971 | IF(ITT.EQ.1) THEN |
---|
5972 | ITT=2 |
---|
5973 | ELSE |
---|
5974 | ITT=1 |
---|
5975 | ENDIF |
---|
5976 | IJKL=IKM1-JLK |
---|
5977 | IKU2=(IJKL-1)*NG1P1+1 |
---|
5978 | C |
---|
5979 | C |
---|
5980 | IF(ITT.EQ.1) THEN |
---|
5981 | CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL) |
---|
5982 | 2 , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT1) |
---|
5983 | ELSE |
---|
5984 | CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL) |
---|
5985 | 2 , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT2) |
---|
5986 | ENDIF |
---|
5987 | C |
---|
5988 | DO 2265 JA = 1, KTRAER |
---|
5989 | DO 2264 JL = 1, KDLON |
---|
5990 | ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5 |
---|
5991 | 2264 CONTINUE |
---|
5992 | 2265 CONTINUE |
---|
5993 | C |
---|
5994 | DO 2266 JL = 1, KDLON |
---|
5995 | ZWW=PDBDT(JL,1,IJKL)*ZTT(JL,1) *ZTT(JL,10) |
---|
5996 | S +PDBDT(JL,2,IJKL)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
---|
5997 | S +PDBDT(JL,3,IJKL)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
---|
5998 | S +PDBDT(JL,4,IJKL)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
---|
5999 | S +PDBDT(JL,5,IJKL)*ZTT(JL,3) *ZTT(JL,14) |
---|
6000 | S +PDBDT(JL,6,IJKL)*ZTT(JL,6) *ZTT(JL,15) |
---|
6001 | ZGLAYU(JL)=ZWW |
---|
6002 | ZDZXMG=ZGLAYU(JL) |
---|
6003 | PDISU(JL,JK)=PDISU(JL,JK)+ZDZXMG |
---|
6004 | PCNTRB(JL,JK,IJKL)=ZDZXMG |
---|
6005 | 2266 CONTINUE |
---|
6006 | C |
---|
6007 | C |
---|
6008 | 227 CONTINUE |
---|
6009 | 228 CONTINUE |
---|
6010 | C |
---|
6011 | RETURN |
---|
6012 | END |
---|
6013 | SUBROUTINE LWVN(KUAER,KTRAER |
---|
6014 | R , PABCU,PDBSL,PGA,PGB |
---|
6015 | S , PADJD,PADJU,PCNTRB,PDBDT) |
---|
6016 | USE dimphy |
---|
6017 | IMPLICIT none |
---|
6018 | cym#include "dimensions.h" |
---|
6019 | cym#include "dimphy.h" |
---|
6020 | cym#include "raddim.h" |
---|
6021 | #include "raddimlw.h" |
---|
6022 | C |
---|
6023 | C----------------------------------------------------------------------- |
---|
6024 | C PURPOSE. |
---|
6025 | C -------- |
---|
6026 | C CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS |
---|
6027 | C TO GIVE LONGWAVE FLUXES OR RADIANCES |
---|
6028 | C |
---|
6029 | C METHOD. |
---|
6030 | C ------- |
---|
6031 | C |
---|
6032 | C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE |
---|
6033 | C CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE |
---|
6034 | C |
---|
6035 | C REFERENCE. |
---|
6036 | C ---------- |
---|
6037 | C |
---|
6038 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
6039 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
6040 | C |
---|
6041 | C AUTHOR. |
---|
6042 | C ------- |
---|
6043 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
6044 | C |
---|
6045 | C MODIFICATIONS. |
---|
6046 | C -------------- |
---|
6047 | C ORIGINAL : 89-07-14 |
---|
6048 | C----------------------------------------------------------------------- |
---|
6049 | C |
---|
6050 | C* ARGUMENTS: |
---|
6051 | C |
---|
6052 | INTEGER KUAER,KTRAER |
---|
6053 | C |
---|
6054 | REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS |
---|
6055 | REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
---|
6056 | REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
6057 | REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
---|
6058 | C |
---|
6059 | REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS |
---|
6060 | REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS |
---|
6061 | REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX |
---|
6062 | REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT |
---|
6063 | C |
---|
6064 | C* LOCAL ARRAYS: |
---|
6065 | C |
---|
6066 | REAL*8 ZGLAYD(KDLON) |
---|
6067 | REAL*8 ZGLAYU(KDLON) |
---|
6068 | REAL*8 ZTT(KDLON,NTRA) |
---|
6069 | REAL*8 ZTT1(KDLON,NTRA) |
---|
6070 | REAL*8 ZTT2(KDLON,NTRA) |
---|
6071 | REAL*8 ZUU(KDLON,NUA) |
---|
6072 | C |
---|
6073 | INTEGER jk, jl, ja, im12, ind, inu, ixu, jg |
---|
6074 | INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu |
---|
6075 | REAL*8 zwtr |
---|
6076 | c |
---|
6077 | C* Data Block: |
---|
6078 | c |
---|
6079 | REAL*8 WG1(2) |
---|
6080 | SAVE WG1 |
---|
6081 | c$OMP THREADPRIVATE(WG1) |
---|
6082 | DATA (WG1(jk),jk=1,2) /1.0, 1.0/ |
---|
6083 | C----------------------------------------------------------------------- |
---|
6084 | C |
---|
6085 | C* 1. INITIALIZATION |
---|
6086 | C -------------- |
---|
6087 | C |
---|
6088 | 100 CONTINUE |
---|
6089 | C |
---|
6090 | C* 1.1 INITIALIZE LAYER CONTRIBUTIONS |
---|
6091 | C ------------------------------ |
---|
6092 | C |
---|
6093 | 110 CONTINUE |
---|
6094 | C |
---|
6095 | DO 112 JK = 1 , KFLEV+1 |
---|
6096 | DO 111 JL = 1, KDLON |
---|
6097 | PADJD(JL,JK) = 0. |
---|
6098 | PADJU(JL,JK) = 0. |
---|
6099 | 111 CONTINUE |
---|
6100 | 112 CONTINUE |
---|
6101 | C |
---|
6102 | C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
---|
6103 | C --------------------------------- |
---|
6104 | C |
---|
6105 | 120 CONTINUE |
---|
6106 | C |
---|
6107 | DO 122 JA = 1 , NTRA |
---|
6108 | DO 121 JL = 1, KDLON |
---|
6109 | ZTT (JL,JA) = 1.0 |
---|
6110 | ZTT1(JL,JA) = 1.0 |
---|
6111 | ZTT2(JL,JA) = 1.0 |
---|
6112 | 121 CONTINUE |
---|
6113 | 122 CONTINUE |
---|
6114 | C |
---|
6115 | DO 124 JA = 1 , NUA |
---|
6116 | DO 123 JL = 1, KDLON |
---|
6117 | ZUU(JL,JA) = 0. |
---|
6118 | 123 CONTINUE |
---|
6119 | 124 CONTINUE |
---|
6120 | C |
---|
6121 | C ------------------------------------------------------------------ |
---|
6122 | C |
---|
6123 | C* 2. VERTICAL INTEGRATION |
---|
6124 | C -------------------- |
---|
6125 | C |
---|
6126 | 200 CONTINUE |
---|
6127 | C |
---|
6128 | C |
---|
6129 | C* 2.1 CONTRIBUTION FROM ADJACENT LAYERS |
---|
6130 | C --------------------------------- |
---|
6131 | C |
---|
6132 | 210 CONTINUE |
---|
6133 | C |
---|
6134 | DO 215 JK = 1 , KFLEV |
---|
6135 | C |
---|
6136 | C* 2.1.1 DOWNWARD LAYERS |
---|
6137 | C --------------- |
---|
6138 | C |
---|
6139 | 2110 CONTINUE |
---|
6140 | C |
---|
6141 | IM12 = 2 * (JK - 1) |
---|
6142 | IND = (JK - 1) * NG1P1 + 1 |
---|
6143 | IXD = IND |
---|
6144 | INU = JK * NG1P1 + 1 |
---|
6145 | IXU = IND |
---|
6146 | C |
---|
6147 | DO 2111 JL = 1, KDLON |
---|
6148 | ZGLAYD(JL) = 0. |
---|
6149 | ZGLAYU(JL) = 0. |
---|
6150 | 2111 CONTINUE |
---|
6151 | C |
---|
6152 | DO 213 JG = 1 , NG1 |
---|
6153 | IBS = IM12 + JG |
---|
6154 | IDD = IXD + JG |
---|
6155 | DO 2113 JA = 1 , KUAER |
---|
6156 | DO 2112 JL = 1, KDLON |
---|
6157 | ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD) |
---|
6158 | 2112 CONTINUE |
---|
6159 | 2113 CONTINUE |
---|
6160 | C |
---|
6161 | C |
---|
6162 | CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT) |
---|
6163 | C |
---|
6164 | DO 2114 JL = 1, KDLON |
---|
6165 | ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1) *ZTT(JL,10) |
---|
6166 | S +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
---|
6167 | S +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
---|
6168 | S +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
---|
6169 | S +PDBSL(JL,5,IBS)*ZTT(JL,3) *ZTT(JL,14) |
---|
6170 | S +PDBSL(JL,6,IBS)*ZTT(JL,6) *ZTT(JL,15) |
---|
6171 | ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG1(JG) |
---|
6172 | 2114 CONTINUE |
---|
6173 | C |
---|
6174 | C* 2.1.2 DOWNWARD LAYERS |
---|
6175 | C --------------- |
---|
6176 | C |
---|
6177 | 2120 CONTINUE |
---|
6178 | C |
---|
6179 | IMU = IXU + JG |
---|
6180 | DO 2122 JA = 1 , KUAER |
---|
6181 | DO 2121 JL = 1, KDLON |
---|
6182 | ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU) |
---|
6183 | 2121 CONTINUE |
---|
6184 | 2122 CONTINUE |
---|
6185 | C |
---|
6186 | C |
---|
6187 | CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT) |
---|
6188 | C |
---|
6189 | DO 2123 JL = 1, KDLON |
---|
6190 | ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1) *ZTT(JL,10) |
---|
6191 | S +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
---|
6192 | S +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
---|
6193 | S +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
---|
6194 | S +PDBSL(JL,5,IBS)*ZTT(JL,3) *ZTT(JL,14) |
---|
6195 | S +PDBSL(JL,6,IBS)*ZTT(JL,6) *ZTT(JL,15) |
---|
6196 | ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG1(JG) |
---|
6197 | 2123 CONTINUE |
---|
6198 | C |
---|
6199 | 213 CONTINUE |
---|
6200 | C |
---|
6201 | DO 214 JL = 1, KDLON |
---|
6202 | PADJD(JL,JK) = ZGLAYD(JL) |
---|
6203 | PCNTRB(JL,JK,JK+1) = ZGLAYD(JL) |
---|
6204 | PADJU(JL,JK+1) = ZGLAYU(JL) |
---|
6205 | PCNTRB(JL,JK+1,JK) = ZGLAYU(JL) |
---|
6206 | PCNTRB(JL,JK ,JK) = 0.0 |
---|
6207 | 214 CONTINUE |
---|
6208 | C |
---|
6209 | 215 CONTINUE |
---|
6210 | C |
---|
6211 | DO 218 JK = 1 , KFLEV |
---|
6212 | JK2 = 2 * JK |
---|
6213 | JK1 = JK2 - 1 |
---|
6214 | DO 217 JNU = 1 , Ninter |
---|
6215 | DO 216 JL = 1, KDLON |
---|
6216 | PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2) |
---|
6217 | 216 CONTINUE |
---|
6218 | 217 CONTINUE |
---|
6219 | 218 CONTINUE |
---|
6220 | C |
---|
6221 | RETURN |
---|
6222 | C |
---|
6223 | END |
---|
6224 | SUBROUTINE LWTT(PGA,PGB,PUU, PTT) |
---|
6225 | USE dimphy |
---|
6226 | IMPLICIT none |
---|
6227 | cym#include "dimensions.h" |
---|
6228 | cym#include "dimphy.h" |
---|
6229 | cym#include "raddim.h" |
---|
6230 | #include "raddimlw.h" |
---|
6231 | C |
---|
6232 | C----------------------------------------------------------------------- |
---|
6233 | C PURPOSE. |
---|
6234 | C -------- |
---|
6235 | C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
---|
6236 | C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL |
---|
6237 | C INTERVALS. |
---|
6238 | C |
---|
6239 | C METHOD. |
---|
6240 | C ------- |
---|
6241 | C |
---|
6242 | C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE |
---|
6243 | C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM. |
---|
6244 | C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL. |
---|
6245 | C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN |
---|
6246 | C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT. |
---|
6247 | C |
---|
6248 | C REFERENCE. |
---|
6249 | C ---------- |
---|
6250 | C |
---|
6251 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
6252 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
6253 | C |
---|
6254 | C AUTHOR. |
---|
6255 | C ------- |
---|
6256 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
6257 | C |
---|
6258 | C MODIFICATIONS. |
---|
6259 | C -------------- |
---|
6260 | C ORIGINAL : 88-12-15 |
---|
6261 | C |
---|
6262 | C----------------------------------------------------------------------- |
---|
6263 | REAL*8 O1H, O2H |
---|
6264 | PARAMETER (O1H=2230.) |
---|
6265 | PARAMETER (O2H=100.) |
---|
6266 | REAL*8 RPIALF0 |
---|
6267 | PARAMETER (RPIALF0=2.0) |
---|
6268 | C |
---|
6269 | C* ARGUMENTS: |
---|
6270 | C |
---|
6271 | REAL*8 PUU(KDLON,NUA) |
---|
6272 | REAL*8 PTT(KDLON,NTRA) |
---|
6273 | REAL*8 PGA(KDLON,8,2) |
---|
6274 | REAL*8 PGB(KDLON,8,2) |
---|
6275 | C |
---|
6276 | C* LOCAL VARIABLES: |
---|
6277 | C |
---|
6278 | REAL*8 zz, zxd, zxn |
---|
6279 | REAL*8 zpu, zpu10, zpu11, zpu12, zpu13 |
---|
6280 | REAL*8 zeu, zeu10, zeu11, zeu12, zeu13 |
---|
6281 | REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy |
---|
6282 | REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o |
---|
6283 | REAL*8 zsqn21, zodn21, zsqh42, zodh42 |
---|
6284 | REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12 |
---|
6285 | REAL*8 zuu11, zuu12, za11, za12 |
---|
6286 | INTEGER jl, ja |
---|
6287 | C ------------------------------------------------------------------ |
---|
6288 | C |
---|
6289 | C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION |
---|
6290 | C ----------------------------------------------- |
---|
6291 | C |
---|
6292 | 100 CONTINUE |
---|
6293 | C |
---|
6294 | C |
---|
6295 | DO 130 JA = 1 , 8 |
---|
6296 | DO 120 JL = 1, KDLON |
---|
6297 | ZZ =SQRT(PUU(JL,JA)) |
---|
6298 | c ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1)) |
---|
6299 | c ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) ) |
---|
6300 | c PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1) |
---|
6301 | ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ ) |
---|
6302 | ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) ) |
---|
6303 | PTT(JL,JA)=ZXN /ZXD |
---|
6304 | 120 CONTINUE |
---|
6305 | 130 CONTINUE |
---|
6306 | C |
---|
6307 | C ------------------------------------------------------------------ |
---|
6308 | C |
---|
6309 | C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS |
---|
6310 | C --------------------------------------------------- |
---|
6311 | C |
---|
6312 | 200 CONTINUE |
---|
6313 | C |
---|
6314 | DO 201 JL = 1, KDLON |
---|
6315 | PTT(JL, 9) = PTT(JL, 8) |
---|
6316 | C |
---|
6317 | C- CONTINUUM ABSORPTION: E- AND P-TYPE |
---|
6318 | C |
---|
6319 | ZPU = 0.002 * PUU(JL,10) |
---|
6320 | ZPU10 = 112. * ZPU |
---|
6321 | ZPU11 = 6.25 * ZPU |
---|
6322 | ZPU12 = 5.00 * ZPU |
---|
6323 | ZPU13 = 80.0 * ZPU |
---|
6324 | ZEU = PUU(JL,11) |
---|
6325 | ZEU10 = 12. * ZEU |
---|
6326 | ZEU11 = 6.25 * ZEU |
---|
6327 | ZEU12 = 5.00 * ZEU |
---|
6328 | ZEU13 = 80.0 * ZEU |
---|
6329 | C |
---|
6330 | C- OZONE ABSORPTION |
---|
6331 | C |
---|
6332 | ZX = PUU(JL,12) |
---|
6333 | ZY = PUU(JL,13) |
---|
6334 | ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY) |
---|
6335 | ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1. |
---|
6336 | ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1. |
---|
6337 | ZVXY = RPIALF0 * ZY / (2. * ZX) |
---|
6338 | ZAERCN = PUU(JL,17) + ZEU12 + ZPU12 |
---|
6339 | ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN ) |
---|
6340 | ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN ) |
---|
6341 | C |
---|
6342 | C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12) |
---|
6343 | C |
---|
6344 | C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6345 | C |
---|
6346 | c NEXOTIC=1 |
---|
6347 | c IF (NEXOTIC.EQ.1) THEN |
---|
6348 | ZXCH4 = PUU(JL,19) |
---|
6349 | ZYCH4 = PUU(JL,20) |
---|
6350 | ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4) |
---|
6351 | ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1. |
---|
6352 | ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4) |
---|
6353 | ZODH41 = ZVXY * ZSQH41 |
---|
6354 | C |
---|
6355 | C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6356 | C |
---|
6357 | ZXN2O = PUU(JL,21) |
---|
6358 | ZYN2O = PUU(JL,22) |
---|
6359 | ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O) |
---|
6360 | ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1. |
---|
6361 | ZVXY = 0.416 * ZYN2O / (2. * ZXN2O) |
---|
6362 | ZODN21 = ZVXY * ZSQN21 |
---|
6363 | C |
---|
6364 | C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
---|
6365 | C |
---|
6366 | ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4) |
---|
6367 | ZSQH42 = SQRT(1. + 400. * ZUXY) - 1. |
---|
6368 | ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4) |
---|
6369 | ZODH42 = ZVXY * ZSQH42 |
---|
6370 | C |
---|
6371 | C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
---|
6372 | C |
---|
6373 | ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O) |
---|
6374 | ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1. |
---|
6375 | ZVXY = 0.197 * ZYN2O / (2. * ZXN2O) |
---|
6376 | ZODN22 = ZVXY * ZSQN22 |
---|
6377 | C |
---|
6378 | C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6379 | C |
---|
6380 | ZA11 = 2. * PUU(JL,23) * 4.404E+05 |
---|
6381 | ZTTF11 = 1. - ZA11 * 0.003225 |
---|
6382 | C |
---|
6383 | C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6384 | C |
---|
6385 | ZA12 = 2. * PUU(JL,24) * 6.7435E+05 |
---|
6386 | ZTTF12 = 1. - ZA12 * 0.003225 |
---|
6387 | C |
---|
6388 | ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10 |
---|
6389 | ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21 |
---|
6390 | PTT(JL,10) = EXP( - PUU(JL,14) ) |
---|
6391 | PTT(JL,11) = EXP( ZUU11 ) |
---|
6392 | PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12 |
---|
6393 | PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2 |
---|
6394 | PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 ) |
---|
6395 | PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 ) |
---|
6396 | 201 CONTINUE |
---|
6397 | C |
---|
6398 | RETURN |
---|
6399 | END |
---|
6400 | SUBROUTINE LWTTM(PGA,PGB,PUU1,PUU2, PTT) |
---|
6401 | USE dimphy |
---|
6402 | IMPLICIT none |
---|
6403 | cym#include "dimensions.h" |
---|
6404 | cym#include "dimphy.h" |
---|
6405 | cym#include "raddim.h" |
---|
6406 | #include "raddimlw.h" |
---|
6407 | C |
---|
6408 | C ------------------------------------------------------------------ |
---|
6409 | C PURPOSE. |
---|
6410 | C -------- |
---|
6411 | C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
---|
6412 | C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL |
---|
6413 | C INTERVALS. |
---|
6414 | C |
---|
6415 | C METHOD. |
---|
6416 | C ------- |
---|
6417 | C |
---|
6418 | C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE |
---|
6419 | C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM. |
---|
6420 | C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL. |
---|
6421 | C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN |
---|
6422 | C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT. |
---|
6423 | C |
---|
6424 | C REFERENCE. |
---|
6425 | C ---------- |
---|
6426 | C |
---|
6427 | C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
6428 | C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
6429 | C |
---|
6430 | C AUTHOR. |
---|
6431 | C ------- |
---|
6432 | C JEAN-JACQUES MORCRETTE *ECMWF* |
---|
6433 | C |
---|
6434 | C MODIFICATIONS. |
---|
6435 | C -------------- |
---|
6436 | C ORIGINAL : 88-12-15 |
---|
6437 | C |
---|
6438 | C----------------------------------------------------------------------- |
---|
6439 | REAL*8 O1H, O2H |
---|
6440 | PARAMETER (O1H=2230.) |
---|
6441 | PARAMETER (O2H=100.) |
---|
6442 | REAL*8 RPIALF0 |
---|
6443 | PARAMETER (RPIALF0=2.0) |
---|
6444 | C |
---|
6445 | C* ARGUMENTS: |
---|
6446 | C |
---|
6447 | REAL*8 PGA(KDLON,8,2) ! PADE APPROXIMANTS |
---|
6448 | REAL*8 PGB(KDLON,8,2) ! PADE APPROXIMANTS |
---|
6449 | REAL*8 PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1 |
---|
6450 | REAL*8 PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2 |
---|
6451 | REAL*8 PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS |
---|
6452 | C |
---|
6453 | C* LOCAL VARIABLES: |
---|
6454 | C |
---|
6455 | INTEGER ja, jl |
---|
6456 | REAL*8 zz, zxd, zxn |
---|
6457 | REAL*8 zpu, zpu10, zpu11, zpu12, zpu13 |
---|
6458 | REAL*8 zeu, zeu10, zeu11, zeu12, zeu13 |
---|
6459 | REAL*8 zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2 |
---|
6460 | REAL*8 zxch4, zych4, zsqh41, zodh41 |
---|
6461 | REAL*8 zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42 |
---|
6462 | REAL*8 zsqn22, zodn22, za11, zttf11, za12, zttf12 |
---|
6463 | REAL*8 zuu11, zuu12 |
---|
6464 | C ------------------------------------------------------------------ |
---|
6465 | C |
---|
6466 | C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION |
---|
6467 | C ----------------------------------------------- |
---|
6468 | C |
---|
6469 | 100 CONTINUE |
---|
6470 | C |
---|
6471 | C |
---|
6472 | DO 130 JA = 1 , 8 |
---|
6473 | DO 120 JL = 1, KDLON |
---|
6474 | ZZ =SQRT(PUU1(JL,JA) - PUU2(JL,JA)) |
---|
6475 | ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ ) |
---|
6476 | ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) ) |
---|
6477 | PTT(JL,JA)=ZXN /ZXD |
---|
6478 | 120 CONTINUE |
---|
6479 | 130 CONTINUE |
---|
6480 | C |
---|
6481 | C ------------------------------------------------------------------ |
---|
6482 | C |
---|
6483 | C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS |
---|
6484 | C --------------------------------------------------- |
---|
6485 | C |
---|
6486 | 200 CONTINUE |
---|
6487 | C |
---|
6488 | DO 201 JL = 1, KDLON |
---|
6489 | PTT(JL, 9) = PTT(JL, 8) |
---|
6490 | C |
---|
6491 | C- CONTINUUM ABSORPTION: E- AND P-TYPE |
---|
6492 | C |
---|
6493 | ZPU = 0.002 * (PUU1(JL,10) - PUU2(JL,10)) |
---|
6494 | ZPU10 = 112. * ZPU |
---|
6495 | ZPU11 = 6.25 * ZPU |
---|
6496 | ZPU12 = 5.00 * ZPU |
---|
6497 | ZPU13 = 80.0 * ZPU |
---|
6498 | ZEU = (PUU1(JL,11) - PUU2(JL,11)) |
---|
6499 | ZEU10 = 12. * ZEU |
---|
6500 | ZEU11 = 6.25 * ZEU |
---|
6501 | ZEU12 = 5.00 * ZEU |
---|
6502 | ZEU13 = 80.0 * ZEU |
---|
6503 | C |
---|
6504 | C- OZONE ABSORPTION |
---|
6505 | C |
---|
6506 | ZX = (PUU1(JL,12) - PUU2(JL,12)) |
---|
6507 | ZY = (PUU1(JL,13) - PUU2(JL,13)) |
---|
6508 | ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY) |
---|
6509 | ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1. |
---|
6510 | ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1. |
---|
6511 | ZVXY = RPIALF0 * ZY / (2. * ZX) |
---|
6512 | ZAERCN = (PUU1(JL,17) -PUU2(JL,17)) + ZEU12 + ZPU12 |
---|
6513 | ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN ) |
---|
6514 | ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN ) |
---|
6515 | C |
---|
6516 | C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12) |
---|
6517 | C |
---|
6518 | C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6519 | C |
---|
6520 | ZXCH4 = (PUU1(JL,19) - PUU2(JL,19)) |
---|
6521 | ZYCH4 = (PUU1(JL,20) - PUU2(JL,20)) |
---|
6522 | ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4) |
---|
6523 | ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1. |
---|
6524 | ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4) |
---|
6525 | ZODH41 = ZVXY * ZSQH41 |
---|
6526 | C |
---|
6527 | C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6528 | C |
---|
6529 | ZXN2O = (PUU1(JL,21) - PUU2(JL,21)) |
---|
6530 | ZYN2O = (PUU1(JL,22) - PUU2(JL,22)) |
---|
6531 | ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O) |
---|
6532 | ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1. |
---|
6533 | ZVXY = 0.416 * ZYN2O / (2. * ZXN2O) |
---|
6534 | ZODN21 = ZVXY * ZSQN21 |
---|
6535 | C |
---|
6536 | C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
---|
6537 | C |
---|
6538 | ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4) |
---|
6539 | ZSQH42 = SQRT(1. + 400. * ZUXY) - 1. |
---|
6540 | ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4) |
---|
6541 | ZODH42 = ZVXY * ZSQH42 |
---|
6542 | C |
---|
6543 | C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1 |
---|
6544 | C |
---|
6545 | ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O) |
---|
6546 | ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1. |
---|
6547 | ZVXY = 0.197 * ZYN2O / (2. * ZXN2O) |
---|
6548 | ZODN22 = ZVXY * ZSQN22 |
---|
6549 | C |
---|
6550 | C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6551 | C |
---|
6552 | ZA11 = (PUU1(JL,23) - PUU2(JL,23)) * 4.404E+05 |
---|
6553 | ZTTF11 = 1. - ZA11 * 0.003225 |
---|
6554 | C |
---|
6555 | C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1 |
---|
6556 | C |
---|
6557 | ZA12 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05 |
---|
6558 | ZTTF12 = 1. - ZA12 * 0.003225 |
---|
6559 | C |
---|
6560 | ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10 |
---|
6561 | ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 - |
---|
6562 | S ZODH41 - ZODN21 |
---|
6563 | PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(JL,14)) ) |
---|
6564 | PTT(JL,11) = EXP( ZUU11 ) |
---|
6565 | PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12 |
---|
6566 | PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2 |
---|
6567 | PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 ) |
---|
6568 | PTT(JL,15) = EXP ( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 ) |
---|
6569 | 201 CONTINUE |
---|
6570 | C |
---|
6571 | RETURN |
---|
6572 | END |
---|