GCC Code Coverage Report

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