Directory: | ./ |
---|---|
File: | rad/swni.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 218 | 230 | 94.8% |
Branches: | 85 | 88 | 96.6% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 360 | SUBROUTINE SWNI & | |
2 | & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& | ||
3 | 360 | & PAER , PAKI , PALBD , PALBP, PCG , PCLD, PCLEAR,& | |
4 | 360 | & PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU,& | |
5 | 360 | & PUD , PWV , PQS,& | |
6 | 360 | & PFDOWN, PFUP , PCDOWN, PCUP , PSUDU2, PDIFF , PDIRF, & | |
7 | !++MODIFCODE | ||
8 | & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST ) | ||
9 | !--MODIFCODE | ||
10 | |||
11 | !**** *SWNI* - SHORTWAVE RADIATION, NEAR-INFRARED SPECTRAL INTERVALS | ||
12 | |||
13 | ! PURPOSE. | ||
14 | ! -------- | ||
15 | |||
16 | ! COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE NEAR-INFRARED | ||
17 | ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). | ||
18 | |||
19 | !** INTERFACE. | ||
20 | ! ---------- | ||
21 | |||
22 | ! *SWNI* IS CALLED FROM *SW*. | ||
23 | |||
24 | ! IMPLICIT ARGUMENTS : | ||
25 | ! -------------------- | ||
26 | |||
27 | ! ==== INPUTS === | ||
28 | ! ==== OUTPUTS === | ||
29 | |||
30 | ! METHOD. | ||
31 | ! ------- | ||
32 | |||
33 | ! 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO | ||
34 | ! CONTINUUM SCATTERING | ||
35 | ! 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR | ||
36 | ! A GREY MOLECULAR ABSORPTION | ||
37 | ! 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS | ||
38 | ! OF ABSORBERS | ||
39 | ! 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS | ||
40 | ! 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION | ||
41 | |||
42 | ! EXTERNALS. | ||
43 | ! ---------- | ||
44 | |||
45 | ! *SWCLR*, *SWR*, *SWDE*, *SWTT* | ||
46 | |||
47 | ! REFERENCE. | ||
48 | ! ---------- | ||
49 | |||
50 | ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT | ||
51 | ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) | ||
52 | |||
53 | ! AUTHOR. | ||
54 | ! ------- | ||
55 | ! JEAN-JACQUES MORCRETTE *ECMWF* | ||
56 | |||
57 | ! MODIFICATIONS. | ||
58 | ! -------------- | ||
59 | ! ORIGINAL : 89-07-14 | ||
60 | ! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO | ||
61 | ! 95-12-07 J.-J. MORCRETTE NEAR-INFRARED SW | ||
62 | ! 990128 JJMorcrette Sunshine duration | ||
63 | ! 99-05-25 JJMorcrette Revised aerosols | ||
64 | ! 03-03-17 JJMorcrette Sunshine duration (correction) | ||
65 | ! 03-10-10 Deborah Salmond and Marta Janiskova Optimisation | ||
66 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
67 | ! 04-11-18 Y.Seity : add 2 arguments for AROME extern. surface | ||
68 | ! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties | ||
69 | ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests | ||
70 | ! ------------------------------------------------------------------ | ||
71 | |||
72 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
73 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
74 | |||
75 | USE YOESW , ONLY : RRAY ,RSUN ,RSWCE ,RSWCP | ||
76 | !++MODIFCODE | ||
77 | !USE YOERAD , ONLY : NSW ,NOVLP | ||
78 | ! NSW mis dans .def MPL 20140211 | ||
79 | USE YOERAD , ONLY : NOVLP | ||
80 | !--MODIFCODE | ||
81 | USE YOERDU , ONLY : REPLOG ,REPSCQ ,REPSC | ||
82 | USE write_field_phy | ||
83 | |||
84 | IMPLICIT NONE | ||
85 | |||
86 | include "clesphys.h" | ||
87 | |||
88 | character*1 str1 | ||
89 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
90 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
91 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
92 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
93 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
94 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
95 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
96 | REAL(KIND=JPRB) ,INTENT(IN) :: PAKI(KLON,2,NSW) | ||
97 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) | ||
98 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
99 | REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) | ||
100 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV) | ||
101 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLEAR(KLON) | ||
102 | REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV) | ||
103 | REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) | ||
104 | REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV) | ||
105 | REAL(KIND=JPRB) ,INTENT(IN) :: PRMU(KLON) | ||
106 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
107 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) | ||
108 | REAL(KIND=JPRB) ,INTENT(IN) :: PUD(KLON,5,KLEV+1) | ||
109 | REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) | ||
110 | REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) | ||
111 | !++MODIFCODE | ||
112 | LOGICAL ,INTENT(IN) :: LRDUST | ||
113 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV) | ||
114 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV) | ||
115 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV) | ||
116 | !--MODIFCODE | ||
117 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1) | ||
118 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1) | ||
119 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1) | ||
120 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1) | ||
121 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU2(KLON) | ||
122 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFF(KLON,KLEV) | ||
123 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRF(KLON,KLEV) | ||
124 | !#include "yoeaer.h" | ||
125 | ! ------------------------------------------------------------------ | ||
126 | |||
127 | !* 0.1 ARGUMENTS | ||
128 | ! --------- | ||
129 | |||
130 | ! ------------------------------------------------------------------ | ||
131 | |||
132 | ! ------------ | ||
133 | |||
134 | INTEGER(KIND=JPIM) :: IIND2(2), IIND3(6) | ||
135 | 720 | REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV) , ZDIFF(KLON) , ZDIRF(KLON)& | |
136 | 720 | & , ZFD(KLON,KLEV+1) , ZFU(KLON,KLEV+1) & | |
137 | 720 | & , ZG(KLON) , ZGG(KLON) | |
138 | 720 | REAL(KIND=JPRB) :: ZPIZAZ(KLON,KLEV)& | |
139 | 720 | & , ZRAYL(KLON) , ZRAY1(KLON,KLEV+1) , ZRAY2(KLON,KLEV+1)& | |
140 | 720 | & , ZREF(KLON) , ZREFZ(KLON,2,KLEV+1)& | |
141 | 720 | & , ZRE1(KLON) , ZRE2(KLON)& | |
142 | 720 | & , ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)& | |
143 | 720 | & , ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)& | |
144 | 720 | & , ZRL(KLON,8)& | |
145 | 720 | & , ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1) , ZRMUZ(KLON)& | |
146 | 720 | & , ZRNEB(KLON) , ZRUEF(KLON,8) , ZR1(KLON) & | |
147 | 720 | & , ZR2(KLON,2) , ZR3(KLON,6) , ZR4(KLON,2)& | |
148 | 720 | & , ZR21(KLON) , ZR22(KLON) | |
149 | 720 | REAL(KIND=JPRB) :: ZS(KLON)& | |
150 | 720 | & , ZTAUAZ(KLON,KLEV) , ZTO1(KLON) , ZTR(KLON,2,KLEV+1)& | |
151 | 720 | & , ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)& | |
152 | 720 | & , ZTRCLD(KLON) , ZTRCLR(KLON)& | |
153 | 720 | & , ZTR1(KLON) , ZTR2(KLON)& | |
154 | 720 | & , ZW(KLON) , ZW1(KLON) , ZW2(KLON,2)& | |
155 | 720 | & , ZW3(KLON,6) , ZW4(KLON,2) , ZW5(KLON,2) | |
156 | |||
157 | INTEGER(KIND=JPIM) :: IABS, IKL, IKM1, JABS, JAJ, JAJP, JK, JKKI,& | ||
158 | & JKKP4, JKL, JKLP1, JKM1, JL, JN, JN2J, JREF | ||
159 | |||
160 | REAL(KIND=JPRB) :: ZAA, ZBB, ZCNEB, ZRE11, ZRKI, ZRMUM1, ZWH2O, ZCHKG, ZCHKS | ||
161 | REAL(KIND=JPRB) :: ZRR,ZRRJ,ZRRK | ||
162 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
163 | !++MODIF_CODE | ||
164 | 720 | REAL(KIND=JPRB) :: ZB_ODI(KLON) | |
165 | !--MODIF_CODE | ||
166 | LOGICAL :: LLDEBUG | ||
167 | |||
168 | INTERFACE | ||
169 | SUBROUTINE SWCLR& | ||
170 | & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,& | ||
171 | & PAER , PALBP , PDSIG , PRAYL , PSEC,& | ||
172 | & PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ,& | ||
173 | & PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR,& | ||
174 | & LRDUST,PPIZA_DST, PCGA_DST, PTAUREL_DST ) | ||
175 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
176 | USE YOERAD , ONLY : NOVLP | ||
177 | include "clesphys.h" | ||
178 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
179 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
180 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
181 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
182 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
183 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
184 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
185 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
186 | REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV) | ||
187 | REAL(KIND=JPRB) ,INTENT(IN) :: PRAYL(KLON) | ||
188 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
189 | LOGICAL ,INTENT(IN) :: LRDUST | ||
190 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV) | ||
191 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV) | ||
192 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV) | ||
193 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCGAZ(KLON,KLEV) | ||
194 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPIZAZ(KLON,KLEV) | ||
195 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1) | ||
196 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1) | ||
197 | REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1) | ||
198 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1) | ||
199 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1) | ||
200 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU0(KLON,KLEV+1) | ||
201 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAZ(KLON,KLEV) | ||
202 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1) | ||
203 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1) | ||
204 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLR(KLON) | ||
205 | END SUBROUTINE SWCLR | ||
206 | END INTERFACE | ||
207 | INTERFACE | ||
208 | SUBROUTINE SWDE& | ||
209 | & ( KIDIA, KFDIA, KLON,& | ||
210 | & PGG , PREF , PRMUZ, PTO1, PW,& | ||
211 | & PRE1 , PRE2 , PTR1 , PTR2& | ||
212 | & ) | ||
213 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
214 | USE YOMJFH , ONLY : N_VMASS | ||
215 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
216 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
217 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
218 | REAL(KIND=JPRB) ,INTENT(IN) :: PGG(KLON) | ||
219 | REAL(KIND=JPRB) ,INTENT(IN) :: PREF(KLON) | ||
220 | REAL(KIND=JPRB) ,INTENT(IN) :: PRMUZ(KLON) | ||
221 | REAL(KIND=JPRB) ,INTENT(IN) :: PTO1(KLON) | ||
222 | REAL(KIND=JPRB) ,INTENT(IN) :: PW(KLON) | ||
223 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRE1(KLON) | ||
224 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRE2(KLON) | ||
225 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR1(KLON) | ||
226 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR2(KLON) | ||
227 | END SUBROUTINE SWDE | ||
228 | END INTERFACE | ||
229 | INTERFACE | ||
230 | SUBROUTINE SWR& | ||
231 | & ( KIDIA , KFDIA , KLON , KLEV , KNU,& | ||
232 | & PALBD , PCG , PCLD , POMEGA, PSEC , PTAU,& | ||
233 | & PCGAZ , PPIZAZ, PRAY1, PRAY2 , PREFZ, PRJ , PRK , PRMUE,& | ||
234 | & PTAUAZ, PTRA1 , PTRA2, PTRCLD& | ||
235 | & ) | ||
236 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
237 | USE YOERAD , ONLY : NOVLP | ||
238 | include "clesphys.h" | ||
239 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
240 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
241 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
242 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
243 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
244 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) | ||
245 | REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) | ||
246 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV) | ||
247 | REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) | ||
248 | REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON) | ||
249 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) | ||
250 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGAZ(KLON,KLEV) | ||
251 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZAZ(KLON,KLEV) | ||
252 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1) | ||
253 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1) | ||
254 | REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1) | ||
255 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1) | ||
256 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1) | ||
257 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRMUE(KLON,KLEV+1) | ||
258 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUAZ(KLON,KLEV) | ||
259 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1) | ||
260 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1) | ||
261 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLD(KLON) | ||
262 | END SUBROUTINE SWR | ||
263 | END INTERFACE | ||
264 | INTERFACE | ||
265 | SUBROUTINE SWTT ( KIDIA, KFDIA, KLON, KNU, KA , PU, PTR) | ||
266 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
267 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
268 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
269 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
270 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
271 | INTEGER(KIND=JPIM),INTENT(IN) :: KA | ||
272 | REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON) | ||
273 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON) | ||
274 | END SUBROUTINE SWTT | ||
275 | END INTERFACE | ||
276 | INTERFACE | ||
277 | SUBROUTINE SWTT1 ( KIDIA,KFDIA,KLON,KNU,KABS,KIND, PU, PTR ) | ||
278 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
279 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
280 | INTEGER(KIND=JPIM),INTENT(IN) :: KABS | ||
281 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
282 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
283 | INTEGER(KIND=JPIM),INTENT(IN) :: KNU | ||
284 | INTEGER(KIND=JPIM),INTENT(IN) :: KIND(KABS) | ||
285 | REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS) | ||
286 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS) | ||
287 | END SUBROUTINE SWTT1 | ||
288 | END INTERFACE | ||
289 | |||
290 | LLDEBUG=.FALSE. | ||
291 | |||
292 | IF(LLDEBUG) THEN | ||
293 | write(str1,'(i1)') knu | ||
294 | ! call writefield_phy("sw_zcduvs"//str1,zcduvs,klev+1) | ||
295 | ENDIF | ||
296 | |||
297 | ! ------------------------------------------------------------------ | ||
298 | |||
299 | !* 1. NEAR-INFRARED SPECTRAL INTERVAL (0.68-4.00 MICRON) | ||
300 | ! -------------------------------------------------- | ||
301 | |||
302 | !* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING | ||
303 | ! ----------------------------------------- | ||
304 | |||
305 |
1/2✓ Branch 0 taken 360 times.
✗ Branch 1 not taken.
|
360 | IF (LHOOK) CALL DR_HOOK('SWNI',0,ZHOOK_HANDLE) |
306 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
307 | 357840 | ZRMUM1 = 1.0_JPRB - PRMU(JL) | |
308 | ZRAYL(JL) = RRAY(KNU,1) + ZRMUM1 * (RRAY(KNU,2) + ZRMUM1 & | ||
309 | & * (RRAY(KNU,3) + ZRMUM1 * (RRAY(KNU,4) + ZRMUM1 & | ||
310 | 357840 | & * (RRAY(KNU,5) + ZRMUM1 * RRAY(KNU,6) )))) | |
311 | 358200 | ZRAYL(JL) = MAX (ZRAYL(JL), 0.0_JPRB) | |
312 | ENDDO | ||
313 | |||
314 | ! ------------------------------------------------------------------ | ||
315 | |||
316 | !* 2. CONTINUUM SCATTERING CALCULATIONS | ||
317 | ! --------------------------------- | ||
318 | |||
319 | !* 2.1 CLEAR-SKY FRACTION OF THE COLUMN | ||
320 | ! -------------------------------- | ||
321 | |||
322 | |||
323 | !++MODIFCODE | ||
324 | CALL SWCLR & | ||
325 | &( KIDIA , KFDIA , KLON , KLEV , KAER , KNU & | ||
326 | &, PAER , PALBP , PDSIG , ZRAYL, PSEC & | ||
327 | &, ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 & | ||
328 | &, ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR & | ||
329 | &, LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST & | ||
330 | 360 | &) | |
331 | !--MODIFCODE | ||
332 | |||
333 | !* 2.2 CLOUDY FRACTION OF THE COLUMN | ||
334 | ! ----------------------------- | ||
335 | |||
336 | CALL SWR & | ||
337 | & ( KIDIA , KFDIA , KLON , KLEV , KNU,& | ||
338 | & PALBD , PCG , PCLD , POMEGA, PSEC , PTAU,& | ||
339 | & ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2 , ZREFZ, ZRJ , ZRK, ZRMUE,& | ||
340 | & ZTAUAZ, ZTRA1 , ZTRA2, ZTRCLD & | ||
341 | 360 | & ) | |
342 | |||
343 | ! ------------------------------------------------------------------ | ||
344 | |||
345 | !* 3. SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION | ||
346 | ! ------------------------------------------------------ | ||
347 | |||
348 | JN = 2 | ||
349 | |||
350 |
2/2✓ Branch 0 taken 720 times.
✓ Branch 1 taken 360 times.
|
1080 | DO JABS=1,2 |
351 | |||
352 | !* 3.1 SURFACE CONDITIONS | ||
353 | ! ------------------ | ||
354 | |||
355 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO JL = KIDIA,KFDIA |
356 | 715680 | ZREFZ(JL,2,1) = PALBD(JL,KNU) | |
357 | 716400 | ZREFZ(JL,1,1) = PALBD(JL,KNU) | |
358 | ENDDO | ||
359 | |||
360 | !* 3.2 INTRODUCING CLOUD EFFECTS | ||
361 | ! ------------------------- | ||
362 | |||
363 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO JK = 2 , KLEV+1 |
364 | 28080 | JKM1 = JK - 1 | |
365 | 28080 | IKL=KLEV+1-JKM1 | |
366 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27939600 | DO JL = KIDIA,KFDIA |
367 | 27911520 | ZRNEB(JL) = PCLD(JL,JKM1) | |
368 |
4/4✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 13955760 times.
✓ Branch 2 taken 3276111 times.
✓ Branch 3 taken 10679649 times.
|
27911520 | IF (JABS == 1.AND. ZRNEB(JL) > REPSC ) THEN |
369 | 3276111 | ZWH2O=MAX(PWV(JL,IKL),REPSCQ) | |
370 | 3276111 | ZCNEB=MAX(REPSC ,MIN(ZRNEB(JL),1.0_JPRB-REPSC )) | |
371 | 3276111 | ZBB=PUD(JL,JABS,JKM1)*PQS(JL,IKL)/ZWH2O | |
372 | 3276111 | ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(1.0_JPRB-ZCNEB),REPSCQ) | |
373 | ELSE | ||
374 | 24635409 | ZAA=PUD(JL,JABS,JKM1) | |
375 | ZBB=ZAA | ||
376 | ZCNEB=0.0_JPRB | ||
377 | ZWH2O=MAX(PWV(JL,IKL),REPSCQ) | ||
378 | ENDIF | ||
379 | |||
380 | ! ZEXP1=-ZRKI * ZAA * 1.66_JPRB | ||
381 | ! ZEXP2=-ZRKI * ZAA / ZRMUE(JL,JK) | ||
382 | ! IF ( ZEXP1 > _ZERO_ .OR. ZEXP2 > _ZERO_ & | ||
383 | ! & .OR. ZEXP1 < -700._JPRB .OR. ZEXP2 < -700._JPRB ) THEN | ||
384 | ! WRITE (NULOUT,'(" SWNI 3.2 : JK=",I4," JL=",I4," JABS=",I4,,8E13.6)') & | ||
385 | ! & JK,JL,JABS,ZAA,ZBB,ZRKI,ZCNEB,ZWH2O,ZRMUE(JL,JK),ZEXP1,ZEXP2 | ||
386 | ! END IF | ||
387 | |||
388 | 27911520 | ZRKI = PAKI(JL,JABS,KNU) | |
389 | ! ZS(JL) = EXP(-ZRKI * ZAA * 1.66_JPRB) | ||
390 | ! ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK) ) | ||
391 | |||
392 | 27911520 | ZCHKS = MIN( 200._JPRB, ZRKI * ZAA * 1.66_JPRB ) | |
393 | 27911520 | ZCHKG = MIN( 200._JPRB, ZRKI * ZAA / ZRMUE(JL,JK)) | |
394 | 27911520 | ZS(JL) = EXP( - ZCHKS ) | |
395 | 27911520 | ZG(JL) = EXP( - ZCHKG ) | |
396 | |||
397 | 27911520 | ZTR1(JL) = 0.0_JPRB | |
398 | 27911520 | ZRE1(JL) = 0.0_JPRB | |
399 | 27911520 | ZTR2(JL) = 0.0_JPRB | |
400 | 27911520 | ZRE2(JL) = 0.0_JPRB | |
401 | |||
402 | !++MODIFCODE | ||
403 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 27911520 times.
|
27911520 | IF (NOVLP >= 5)THEN !MESONH VERSION |
404 | ✗ | ZW(JL) =PCG(JL,KNU,JKM1)*PCG(JL,KNU,JKM1) | |
405 | ✗ | ZTO1(JL) = PTAU(JL,KNU,JKM1)*(1-(POMEGA(JL,KNU,JKM1)*ZW(JL))) | |
406 | ✗ | ZW(JL) =POMEGA(JL,KNU,JKM1)*(1-ZW(JL))/(1-(POMEGA(JL,KNU,JKM1)*ZW(JL))) | |
407 | ✗ | ZGG(JL) =PCG(JL,KNU,JKM1)/(1+PCG(JL,KNU,JKM1)) | |
408 | ✗ | ZGG(JL)=ZTO1(JL)*ZW(JL)*ZGG(JL)+ZTAUAZ(JL,JKM1)*ZPIZAZ(JL,JKM1)*ZCGAZ(JL,JKM1) | |
409 | ✗ | ZGG(JL)=ZGG(JL)/(ZTO1(JL)*ZW(JL)+ZTAUAZ(JL,JKM1)*ZPIZAZ(JL,JKM1)) | |
410 | ZB_ODI(JL)=ZTO1(JL) / ZW(JL)& | ||
411 | &+ ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)& | ||
412 | !if g=0 tau/w=tau'/w' | ||
413 | ✗ | &+ ZBB * ZRKI | |
414 | ZB_ODI(JL)=(1/( (ZTO1(JL) / ZW(JL))& | ||
415 | ✗ | &+ (ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)) ))-(1/ZB_ODI(JL)) | |
416 | ✗ | ZB_ODI(JL)=((ZTO1(JL) + ZTAUAZ(JL,JKM1))**2)*ZB_ODI(JL) | |
417 | ✗ | ZW(JL)=ZTO1(JL)*ZW(JL)+ZTAUAZ(JL,JKM1)*ZPIZAZ(JL,JKM1)-ZB_ODI(JL) | |
418 | ✗ | ZTO1(JL) = ZTO1(JL) + ZTAUAZ(JL,JKM1) | |
419 | ✗ | ZW(JL)=ZW(JL)/ZTO1(JL) | |
420 | ELSE !ECMWF VERSION | ||
421 | 27911520 | ZW(JL)= POMEGA(JL,KNU,JKM1) | |
422 | ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL)& | ||
423 | & + ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)& | ||
424 | 27911520 | & + ZBB * ZRKI | |
425 | 27911520 | ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1) | |
426 | 27911520 | ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL) | |
427 | ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)& | ||
428 | 27911520 | & + (1.0_JPRB - ZR22(JL)) * ZCGAZ(JL,JKM1) | |
429 | 27911520 | ZW(JL) = ZR21(JL) / ZTO1(JL) | |
430 | ENDIF | ||
431 | !--MODIFCODE | ||
432 | 27911520 | ZREF(JL) = ZREFZ(JL,1,JKM1) | |
433 | 27939600 | ZRMUZ(JL) = ZRMUE(JL,JK) | |
434 | ENDDO | ||
435 | |||
436 | CALL SWDE ( KIDIA, KFDIA, KLON,& | ||
437 | & ZGG , ZREF , ZRMUZ, ZTO1, ZW,& | ||
438 | 28080 | & ZRE1 , ZRE2 , ZTR1 , ZTR2 ) | |
439 | |||
440 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO JL = KIDIA,KFDIA |
441 | |||
442 | 27911520 | ZRR=1.0_JPRB/(1.0_JPRB-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)) | |
443 | ZREFZ(JL,2,JK) = (1.0_JPRB-ZRNEB(JL)) * (ZRAY1(JL,JKM1)& | ||
444 | & + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)& | ||
445 | & * ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL)& | ||
446 | 27911520 | & + ZRNEB(JL) * ZRE1(JL) | |
447 | |||
448 | ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL)& | ||
449 | 27911520 | & + (ZTRA1(JL,JKM1)) * ZG(JL) * (1.0_JPRB-ZRNEB(JL)) | |
450 | |||
451 | ZREFZ(JL,1,JK)=(1.0_JPRB-ZRNEB(JL))*(ZRAY1(JL,JKM1)& | ||
452 | & +ZREFZ(JL,1,JKM1)*ZTRA1(JL,JKM1)*ZTRA2(JL,JKM1)& | ||
453 | & *ZRR ) & | ||
454 | & *ZG(JL)*ZS(JL)& | ||
455 | 27911520 | & + ZRNEB(JL) * ZRE2(JL) | |
456 | |||
457 | ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL)& | ||
458 | & + (ZTRA1(JL,JKM1) & | ||
459 | & *ZRR ) & | ||
460 | 27939600 | & * ZG(JL) * (1.0_JPRB -ZRNEB(JL)) | |
461 | |||
462 | ENDDO | ||
463 | ENDDO | ||
464 | |||
465 | !* 3.3 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL | ||
466 | ! ------------------------------------------------- | ||
467 | |||
468 |
2/2✓ Branch 0 taken 1440 times.
✓ Branch 1 taken 720 times.
|
2520 | DO JREF=1,2 |
469 | |||
470 | 1440 | JN = JN + 1 | |
471 | |||
472 |
2/2✓ Branch 0 taken 1431360 times.
✓ Branch 1 taken 1440 times.
|
1432800 | DO JL = KIDIA,KFDIA |
473 | 1431360 | ZRJ(JL,JN,KLEV+1) = 1.0_JPRB | |
474 | 1432800 | ZRK(JL,JN,KLEV+1) = ZREFZ(JL,JREF,KLEV+1) | |
475 | ENDDO | ||
476 | |||
477 |
2/2✓ Branch 0 taken 56160 times.
✓ Branch 1 taken 1440 times.
|
58320 | DO JK = 1 , KLEV |
478 | 56160 | JKL = KLEV+1 - JK | |
479 | 56160 | JKLP1 = JKL + 1 | |
480 |
2/2✓ Branch 0 taken 55823040 times.
✓ Branch 1 taken 56160 times.
|
55880640 | DO JL = KIDIA,KFDIA |
481 | 55823040 | ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL) | |
482 | 55823040 | ZRJ(JL,JN,JKL) = ZRE11 | |
483 | 55879200 | ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL) | |
484 | ENDDO | ||
485 | ENDDO | ||
486 | ENDDO | ||
487 | ENDDO | ||
488 | |||
489 | ! ------------------------------------------------------------------ | ||
490 | |||
491 | !* 4. INVERT GREY AND CONTINUUM FLUXES | ||
492 | ! -------------------------------- | ||
493 | |||
494 | !* 4.1 UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES | ||
495 | ! --------------------------------------------- | ||
496 | |||
497 |
2/2✓ Branch 0 taken 14400 times.
✓ Branch 1 taken 360 times.
|
14760 | DO JK = 1 , KLEV+1 |
498 |
2/2✓ Branch 0 taken 28800 times.
✓ Branch 1 taken 14400 times.
|
43560 | DO JAJ = 1 , 5 , 2 |
499 | 43200 | JAJP = JAJ + 1 | |
500 |
2/2✓ Branch 0 taken 42940800 times.
✓ Branch 1 taken 43200 times.
|
42998400 | DO JL = KIDIA,KFDIA |
501 | 42940800 | ZRJ(JL,JAJ,JK)= ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK) | |
502 | 42940800 | ZRK(JL,JAJ,JK)= ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK) | |
503 | 42940800 | ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , REPLOG ) | |
504 | 42984000 | ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , REPLOG ) | |
505 | ENDDO | ||
506 | ENDDO | ||
507 | ENDDO | ||
508 | |||
509 |
2/2✓ Branch 0 taken 14400 times.
✓ Branch 1 taken 360 times.
|
14760 | DO JK = 1 , KLEV+1 |
510 |
2/2✓ Branch 0 taken 28800 times.
✓ Branch 1 taken 14400 times.
|
43560 | DO JAJ = 2 , 6 , 2 |
511 |
2/2✓ Branch 0 taken 42940800 times.
✓ Branch 1 taken 43200 times.
|
42998400 | DO JL = KIDIA,KFDIA |
512 | 42940800 | ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , REPLOG ) | |
513 | 42984000 | ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , REPLOG ) | |
514 | ENDDO | ||
515 | ENDDO | ||
516 | ENDDO | ||
517 | |||
518 | !* 4.2 EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE | ||
519 | ! --------------------------------------------- | ||
520 | |||
521 |
2/2✓ Branch 0 taken 14400 times.
✓ Branch 1 taken 360 times.
|
14760 | DO JK = 1 , KLEV+1 |
522 | JKKI = 1 | ||
523 |
2/2✓ Branch 0 taken 28800 times.
✓ Branch 1 taken 14400 times.
|
43200 | DO JAJ = 1 , 2 |
524 | 28800 | IIND2(1)=JAJ | |
525 | 28800 | IIND2(2)=JAJ | |
526 |
2/2✓ Branch 0 taken 57600 times.
✓ Branch 1 taken 28800 times.
|
100800 | DO JN = 1 , 2 |
527 | 57600 | JN2J = JN + 2 * JAJ | |
528 | 57600 | JKKP4 = JKKI + 4 | |
529 | |||
530 | !* 4.2.1 EFFECTIVE ABSORBER AMOUNTS | ||
531 | ! -------------------------- | ||
532 | |||
533 |
2/2✓ Branch 0 taken 57254400 times.
✓ Branch 1 taken 57600 times.
|
57312000 | DO JL = KIDIA,KFDIA |
534 | 57254400 | ZRR=1.0_JPRB/PAKI(JL,JAJ,KNU) | |
535 | 57254400 | ZRRJ=ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK) | |
536 | 57254400 | ZRRK=ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK) | |
537 | ! ZW2(JL,1) = LOG( ZRRJ ) * ZRR | ||
538 | ! ZW2(JL,2) = LOG( ZRRK ) * ZRR | ||
539 | !--correction Olivier Boucher based on ECMWF code | ||
540 | 57254400 | ZW2(JL,1) = LOG( MAX(1.0_JPRB,ZRRJ) ) * ZRR | |
541 | 57312000 | ZW2(JL,2) = LOG( MAX(1.0_JPRB,ZRRK) ) * ZRR | |
542 | ENDDO | ||
543 | |||
544 | !* 4.2.2 TRANSMISSION FUNCTION | ||
545 | ! --------------------- | ||
546 | |||
547 | CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 2, IIND2,& | ||
548 | & ZW2,& | ||
549 | 57600 | & ZR2 ) | |
550 | |||
551 |
2/2✓ Branch 0 taken 57254400 times.
✓ Branch 1 taken 57600 times.
|
57312000 | DO JL = KIDIA,KFDIA |
552 | 57254400 | ZRL(JL,JKKI) = ZR2(JL,1) | |
553 | 57254400 | ZRUEF(JL,JKKI) = ZW2(JL,1) | |
554 | 57254400 | ZRL(JL,JKKP4) = ZR2(JL,2) | |
555 | 57312000 | ZRUEF(JL,JKKP4) = ZW2(JL,2) | |
556 | ENDDO | ||
557 | |||
558 | 86400 | JKKI=JKKI+1 | |
559 | ENDDO | ||
560 | ENDDO | ||
561 | |||
562 | !* 4.3 UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION | ||
563 | ! ------------------------------------------------------ | ||
564 | |||
565 |
2/2✓ Branch 0 taken 14313600 times.
✓ Branch 1 taken 14400 times.
|
14328360 | DO JL = KIDIA,KFDIA |
566 | PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3)& | ||
567 | 14313600 | & + ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4) | |
568 | PFUP(JL,JK) = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7)& | ||
569 | 14328000 | & + ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8) | |
570 | ENDDO | ||
571 | ! WRITE(*,'("---> Dans SWNI: ZRK1 ZRK2 ",2E12.5)') ZRK(1,1,JK),ZRK(1,2,JK) | ||
572 | ! WRITE(*,'("ZRK1 ZRL5 ZRL7 ",3E12.5)') ZRK(1,1,JK),ZRL(1,5),ZRL(1,7) | ||
573 | ! WRITE(*,'("ZRK2 ZRL6 ZRL8 ",3E12.5)') ZRK(1,2,JK),ZRL(1,6),ZRL(1,8) | ||
574 | ENDDO | ||
575 | |||
576 | ! ------------------------------------------------------------------ | ||
577 | |||
578 | !* 5. MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES | ||
579 | ! ---------------------------------------- | ||
580 | |||
581 | !* 5.1 DOWNWARD FLUXES | ||
582 | ! --------------- | ||
583 | |||
584 | JAJ = 2 | ||
585 | 360 | IIND3(1)=1 | |
586 | 360 | IIND3(2)=2 | |
587 | 360 | IIND3(3)=3 | |
588 | 360 | IIND3(4)=1 | |
589 | 360 | IIND3(5)=2 | |
590 | 360 | IIND3(6)=3 | |
591 | |||
592 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
593 | 357840 | ZW3(JL,1)=0.0_JPRB | |
594 | 357840 | ZW3(JL,2)=0.0_JPRB | |
595 | 357840 | ZW3(JL,3)=0.0_JPRB | |
596 | 357840 | ZW3(JL,4)=0.0_JPRB | |
597 | 357840 | ZW3(JL,5)=0.0_JPRB | |
598 | 357840 | ZW3(JL,6)=0.0_JPRB | |
599 | |||
600 | 357840 | ZW4(JL,1)=0.0_JPRB | |
601 | 357840 | ZW5(JL,1)=0.0_JPRB | |
602 | 357840 | ZR4(JL,1)=1.0_JPRB | |
603 | 357840 | ZW4(JL,2)=0.0_JPRB | |
604 | 357840 | ZW5(JL,2)=0.0_JPRB | |
605 | 357840 | ZR4(JL,2)=1.0_JPRB | |
606 | 358200 | ZFD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) | |
607 | ENDDO | ||
608 |
2/2✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
|
14400 | DO JK = 1 , KLEV |
609 | 14040 | IKL = KLEV+1-JK | |
610 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13969800 | DO JL = KIDIA,KFDIA |
611 | 13955760 | ZRR=1.0_JPRB/ZRMU0(JL,IKL) | |
612 | 13955760 | ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)*ZRR | |
613 | 13955760 | ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)*ZRR | |
614 | 13955760 | ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKL)*ZRR | |
615 | 13955760 | ZW4(JL,1)=ZW4(JL,1)+PUD(JL,4,IKL)*ZRR | |
616 | 13955760 | ZW5(JL,1)=ZW5(JL,1)+PUD(JL,5,IKL)*ZRR | |
617 | |||
618 | 13955760 | ZRR=1.0_JPRB/ZRMUE(JL,IKL) | |
619 | 13955760 | ZW3(JL,4)=ZW3(JL,4)+PUD(JL,1,IKL)*ZRR | |
620 | 13955760 | ZW3(JL,5)=ZW3(JL,5)+PUD(JL,2,IKL)*ZRR | |
621 | 13955760 | ZW3(JL,6)=ZW3(JL,6)+POZ(JL, IKL)*ZRR | |
622 | 13955760 | ZW4(JL,2)=ZW4(JL,2)+PUD(JL,4,IKL)*ZRR | |
623 | 13969800 | ZW5(JL,2)=ZW5(JL,2)+PUD(JL,5,IKL)*ZRR | |
624 | ENDDO | ||
625 | |||
626 | CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 6, IIND3,& | ||
627 | & ZW3,& | ||
628 | 14040 | & ZR3 ) | |
629 | |||
630 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
631 | 13955760 | ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) | |
632 | 13955760 | ZR4(JL,2) = EXP(-RSWCE(KNU)*ZW4(JL,2)-RSWCP(KNU)*ZW5(JL,2)) | |
633 | 13969800 | ZFD(JL,IKL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL,1)* ZRJ0(JL,JAJ,IKL) | |
634 | ENDDO | ||
635 | ENDDO | ||
636 | IF(LLDEBUG) THEN | ||
637 | call writefield_phy('swni_zfd'//str1,ZFD,KLEV+1) | ||
638 | call writefield_phy('swni_zrj0'//str1,ZRJ0(:,jaj,:),KLEV+1) | ||
639 | ENDIF | ||
640 | |||
641 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL=KIDIA,KFDIA |
642 | 357840 | ZDIFF(JL) = ZR3(JL,4)*ZR3(JL,5)*ZR3(JL,6)*ZR4(JL,2)*ZTRCLD(JL) | |
643 | 357840 | ZDIRF(JL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL,1)*ZTRCLR(JL) | |
644 | PSUDU2(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)& | ||
645 | 358200 | & +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU) | |
646 | ENDDO | ||
647 | |||
648 | !* 5.2 UPWARD FLUXES | ||
649 | ! ------------- | ||
650 | |||
651 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
652 | 358200 | ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU) | |
653 | ENDDO | ||
654 | |||
655 |
2/2✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
|
14400 | DO JK = 2 , KLEV+1 |
656 | 14040 | IKM1=JK-1 | |
657 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13969800 | DO JL = KIDIA,KFDIA |
658 | 13955760 | ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB | |
659 | 13955760 | ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB | |
660 | 13955760 | ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKM1)*1.66_JPRB | |
661 | 13955760 | ZW4(JL,1)=ZW4(JL,1)+PUD(JL,4,IKM1)*1.66_JPRB | |
662 | 13969800 | ZW5(JL,1)=ZW5(JL,1)+PUD(JL,5,IKM1)*1.66_JPRB | |
663 | ENDDO | ||
664 | |||
665 | CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 3, IIND3,& | ||
666 | & ZW3,& | ||
667 | 14040 | & ZR3 ) | |
668 | |||
669 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
670 | 13955760 | ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) | |
671 | 13969800 | ZFU(JL,JK) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL,1)* ZRK0(JL,JAJ,JK) | |
672 | ENDDO | ||
673 | ENDDO | ||
674 | |||
675 | ! ------------------------------------------------------------------ | ||
676 | |||
677 | !* 6. INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION | ||
678 | ! -------------------------------------------------- | ||
679 | |||
680 | 360 | IABS=3 | |
681 | |||
682 | !* 6.1 DOWNWARD FLUXES | ||
683 | ! --------------- | ||
684 | |||
685 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
686 | 357840 | ZW1(JL)=0.0_JPRB | |
687 | 357840 | ZW4(JL,1)=0.0_JPRB | |
688 | 357840 | ZW5(JL,1)=0.0_JPRB | |
689 | 357840 | ZR1(JL)=0.0_JPRB | |
690 | PFDOWN(JL,KLEV+1) = ((1.0_JPRB-PCLEAR(JL))*PFDOWN(JL,KLEV+1)& | ||
691 | 357840 | & + PCLEAR(JL) * ZFD(JL,KLEV+1)) * RSUN(KNU) | |
692 | 358200 | PCDOWN(JL,KLEV+1) = ZFD(JL,KLEV+1) * RSUN(KNU) | |
693 | ENDDO | ||
694 | |||
695 |
2/2✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
|
14400 | DO JK = 1 , KLEV |
696 | 14040 | IKL=KLEV+1-JK | |
697 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13969800 | DO JL = KIDIA,KFDIA |
698 | 13955760 | ZRR=1.0_JPRB/ZRMUE(JL,IKL) | |
699 | 13955760 | ZW1(JL) = ZW1(JL)+POZ(JL, IKL) * ZRR | |
700 | 13955760 | ZW4(JL,1) = ZW4(JL,1)+PUD(JL,4,IKL) * ZRR | |
701 | 13955760 | ZW5(JL,1) = ZW5(JL,1)+PUD(JL,5,IKL) * ZRR | |
702 | 13969800 | ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) | |
703 | ENDDO | ||
704 | |||
705 | 14040 | CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 ) | |
706 | |||
707 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
708 | 13955760 | PDIFF(JL,IKL)=ZR1(JL)*ZR4(JL,1)*PFDOWN(JL,IKL)*RSUN(KNU)*(1.0_JPRB-PCLEAR(JL)) | |
709 | 13955760 | PDIRF(JL,IKL)=ZFD(JL,IKL)*RSUN(KNU)* PCLEAR(JL) | |
710 | PFDOWN(JL,IKL) = ((1.0_JPRB-PCLEAR(JL))*ZR1(JL)*ZR4(JL,1)*PFDOWN(JL,IKL)& | ||
711 | 13955760 | & +PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU) | |
712 | 13969800 | PCDOWN(JL,IKL) = ZFD(JL,IKL) * RSUN(KNU) | |
713 | ENDDO | ||
714 | ENDDO | ||
715 | |||
716 | !* 6.2 UPWARD FLUXES | ||
717 | ! ------------- | ||
718 | |||
719 |
2/2✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
|
358200 | DO JL = KIDIA,KFDIA |
720 | PFUP(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZR1(JL)*ZR4(JL,1) * PFUP(JL,1)& | ||
721 | 357840 | & +PCLEAR(JL)*ZFU(JL,1)) * RSUN(KNU) | |
722 | 358200 | PCUP(JL,1) = ZFU(JL,1) * RSUN(KNU) | |
723 | ENDDO | ||
724 | |||
725 |
2/2✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
|
14400 | DO JK = 2 , KLEV+1 |
726 | 14040 | IKM1=JK-1 | |
727 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13969800 | DO JL = KIDIA,KFDIA |
728 | 13955760 | ZW1(JL) = ZW1(JL)+POZ(JL ,IKM1)*1.66_JPRB | |
729 | 13955760 | ZW4(JL,1) = ZW4(JL,1)+PUD(JL,4,IKM1)*1.66_JPRB | |
730 | 13955760 | ZW5(JL,1) = ZW5(JL,1)+PUD(JL,5,IKM1)*1.66_JPRB | |
731 | 13969800 | ZR4(JL,1) = EXP(-RSWCE(KNU)*ZW4(JL,1)-RSWCP(KNU)*ZW5(JL,1)) | |
732 | ENDDO | ||
733 | |||
734 | 14040 | CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 ) | |
735 | |||
736 |
2/2✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
|
13970160 | DO JL = KIDIA,KFDIA |
737 | PFUP(JL,JK) = ((1.0_JPRB-PCLEAR(JL))*ZR1(JL)*ZR4(JL,1) * PFUP(JL,JK)& | ||
738 | 13955760 | & +PCLEAR(JL)*ZFU(JL,JK)) * RSUN(KNU) | |
739 | 13969800 | PCUP(JL,JK) = ZFU(JL,JK) * RSUN(KNU) | |
740 | ENDDO | ||
741 | ENDDO | ||
742 | |||
743 | IF(LLDEBUG) THEN | ||
744 | call writefield_phy('swni_zfd_fin'//str1,ZFD,KLEV+1) | ||
745 | call writefield_phy('swni_pcdown'//str1,PCDOWN,KLEV+1) | ||
746 | ENDIF | ||
747 | ! ------------------------------------------------------------------ | ||
748 | |||
749 |
1/2✓ Branch 0 taken 360 times.
✗ Branch 1 not taken.
|
360 | IF (LHOOK) CALL DR_HOOK('SWNI',1,ZHOOK_HANDLE) |
750 | 360 | END SUBROUTINE SWNI | |
751 |