GCC Code Coverage Report

Directory: ./
File: rad/sw.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 94 94 100.0%
Branches: 47 52 90.4%
Line Branch Exec Source
1 600 SUBROUTINE SW &
2 & ( KIDIA, KFDIA , KLON , KLEV , KAER,&
3 120 & PSCT , PCARDI, PPSOL , PALBD, PALBP , PWV, PQS,&
4 120 & PRMU0, PCG , PCLDSW, PDP , POMEGA, POZ, PPMB,&
5 & PTAU , PTAVE , PAER,&
6 & PFDOWN, PFUP,&
7 & PCDOWN, PCUP,&
8 & PFDNN, PFDNV , PFUPN, PFUPV,&
9 & PCDNN, PCDNV , PCUPN, PCUPV,&
10 & PSUDU, PUVDF , PPARF, PPARCF, PDIFFS , PDIRFS, &
11 & LRDUST, PPIZA_DST,PCGA_DST,PTAUREL_DST &
12 & )
13
14
15 !**** *SW* - COMPUTES THE SHORTWAVE RADIATION FLUXES.
16
17 ! PURPOSE.
18 ! --------
19
20 ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
21 ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
22
23 !** INTERFACE.
24 ! ----------
25
26 ! *SW* IS CALLED FROM *RADLSW*
27
28 ! IMPLICIT ARGUMENTS :
29 ! --------------------
30
31 ! ==== INPUTS ===
32 ! ==== OUTPUTS ===
33
34 ! METHOD.
35 ! -------
36
37 ! 1. COMPUTES ABSORBER AMOUNTS (SWU)
38 ! 2. COMPUTES FLUXES IN U.V./VISIBLE SPECTRAL INTERVAL (SW1S)
39 ! 3. COMPUTES FLUXES IN NEAR-INFRARED SPECTRAL INTERVAL (SWNI)
40
41 ! EXTERNALS.
42 ! ----------
43
44 ! *SWU*, *SW1S*, *SWNI*
45
46 ! REFERENCE.
47 ! ----------
48
49 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
50 ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
51
52 ! AUTHOR.
53 ! -------
54 ! JEAN-JACQUES MORCRETTE *ECMWF*
55
56 ! MODIFICATIONS.
57 ! --------------
58 ! ORIGINAL : 89-07-14
59 ! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
60 ! 95-12-07 J.-J. MORCRETTE Near-Infrared in nsw-1 Intervals
61 ! 990128 JJMorcrette sunshine duration
62 ! 99-05-25 JJMorcrette Revised aerosols
63 ! 00-12-18 JJMorcrette 6 spectral intervals
64 ! 02-09-01 JJMorcrette UV and PAR
65 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
66 ! Y.Seity 04-11-18 : add two arguments for AROME extern. surface
67 ! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties
68 ! JJMorcrette 20060721 PP of clear-sky PAR
69 ! ------------------------------------------------------------------
70
71 USE PARKIND1 ,ONLY : JPIM ,JPRB
72 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
73 !USE YOERAD , ONLY : NSW
74 ! NSW mis dans .def MPL 20140211
75 USE write_field_phy
76
77 IMPLICIT NONE
78
79 include "clesphys.h"
80
81 integer, save :: icount=0
82 !$OMP THREADPRIVATE(icount)
83 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
84 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
85 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
86 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
87 INTEGER(KIND=JPIM),INTENT(IN) :: KAER
88 REAL(KIND=JPRB) ,INTENT(IN) :: PSCT
89 REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI
90 REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON)
91 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW)
92 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW)
93 REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV)
94 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV)
95 REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON)
96 REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV)
97 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV)
98 REAL(KIND=JPRB) :: PDP(KLON,KLEV) ! Argument NOT used
99 REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV)
100 REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV)
101 REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1)
102 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV)
103 REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV)
104 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV)
105 !++MODIFCODE
106 LOGICAL ,INTENT(IN) :: LRDUST
107 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW)
108 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW)
109 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW)
110 !--MODIFCODE
111 REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1)
112 REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1)
113 REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1)
114 REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1)
115 REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNN(KLON)
116 REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNV(KLON)
117 REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPN(KLON)
118 REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPV(KLON)
119 REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNN(KLON)
120 REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNV(KLON)
121 REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPN(KLON)
122 REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPV(KLON)
123 REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON)
124 REAL(KIND=JPRB) ,INTENT(OUT) :: PUVDF(KLON)
125 REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KLON)
126 REAL(KIND=JPRB) ,INTENT(OUT) :: PPARCF(KLON)
127 REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFFS(KLON,NSW)
128 REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRFS(KLON,NSW)
129 ! ------------------------------------------------------------------
130
131 !* 0.1 ARGUMENTS
132 ! ---------
133
134 ! ------------------------------------------------------------------
135
136 ! ------------
137
138 240 REAL(KIND=JPRB) :: ZAKI(KLON,2,NSW)&
139 240 & , ZCLD(KLON,KLEV) , ZCLEAR(KLON) &
140 240 & , ZDSIG(KLON,KLEV) , ZFACT(KLON)&
141 240 & , ZFD(KLON,KLEV+1) , ZCD(KLON,KLEV+1)&
142 240 & , ZCDOWN(KLON,KLEV+1), ZCDNIR(KLON,KLEV+1), ZCDUVS(KLON,KLEV+1)&
143 240 & , ZFDOWN(KLON,KLEV+1), ZFDNIR(KLON,KLEV+1), ZFDUVS(KLON,KLEV+1)&
144 240 & , ZFU(KLON,KLEV+1) , ZCU(KLON,KLEV+1)&
145 240 & , ZCUP(KLON,KLEV+1) , ZCUNIR(KLON,KLEV+1), ZCUUVS(KLON,KLEV+1)&
146 240 & , ZFUP(KLON,KLEV+1) , ZFUNIR(KLON,KLEV+1), ZFUUVS(KLON,KLEV+1)&
147 240 & , ZRMU(KLON) , ZSEC(KLON) &
148 240 & , ZSUDU1(KLON) , ZSUDU2(KLON) &
149 240 & , ZSUDU1T(KLON) , ZSUDU2T(KLON) &
150 240 & , ZUD(KLON,5,KLEV+1) ,ZDIFF(KLON,KLEV) ,ZDIRF(KLON,KLEV) &
151 240 & , ZDIFF2(KLON,KLEV) , ZDIRF2(KLON,KLEV)
152
153 INTEGER(KIND=JPIM) :: JK, JL, JNU, INUVS, INUIR
154
155 REAL(KIND=JPRB) :: ZHOOK_HANDLE
156 LOGICAL :: LLDEBUG
157 character*1 str1
158
159 INTERFACE
160 SUBROUTINE SW1S&
161 & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,&
162 & PAER , PALBD , PALBP, PCG , PCLD , PCLEAR,&
163 & PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD,&
164 & PFD , PFU , PCD , PCU , PSUDU1,PDIFF , PDIRF,&
165 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST&
166 & )
167 USE PARKIND1 ,ONLY : JPIM ,JPRB
168 include "clesphys.h"
169 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
170 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
171 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
172 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
173 INTEGER(KIND=JPIM),INTENT(IN) :: KAER
174 INTEGER(KIND=JPIM),INTENT(IN) :: KNU
175 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV)
176 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW)
177 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW)
178 REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV)
179 REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV)
180 REAL(KIND=JPRB) ,INTENT(IN) :: PCLEAR(KLON)
181 REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV)
182 REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV)
183 REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV)
184 REAL(KIND=JPRB) ,INTENT(IN) :: PRMU(KLON)
185 REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON)
186 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV)
187 REAL(KIND=JPRB) ,INTENT(IN) :: PUD(KLON,5,KLEV+1)
188 LOGICAL ,INTENT(IN) :: LRDUST
189 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV)
190 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV)
191 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV)
192 REAL(KIND=JPRB) ,INTENT(OUT) :: PFD(KLON,KLEV+1)
193 REAL(KIND=JPRB) ,INTENT(OUT) :: PFU(KLON,KLEV+1)
194 REAL(KIND=JPRB) ,INTENT(OUT) :: PCD(KLON,KLEV+1)
195 REAL(KIND=JPRB) ,INTENT(OUT) :: PCU(KLON,KLEV+1)
196 REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU1(KLON)
197 REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFF(KLON,KLEV)
198 REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRF(KLON,KLEV)
199 END SUBROUTINE SW1S
200 END INTERFACE
201 INTERFACE
202 SUBROUTINE SWNI&
203 & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,&
204 & PAER , PAKI , PALBD , PALBP, PCG , PCLD, PCLEAR,&
205 & PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU,&
206 & PUD , PWV , PQS,&
207 & PFDOWN, PFUP , PCDOWN, PCUP , PSUDU2, PDIFF , PDIRF,&
208 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST )
209 USE PARKIND1 ,ONLY : JPIM ,JPRB
210 USE YOERAD , ONLY : NOVLP
211 include "clesphys.h"
212 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
213 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
214 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
215 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
216 INTEGER(KIND=JPIM),INTENT(IN) :: KAER
217 INTEGER(KIND=JPIM),INTENT(IN) :: KNU
218 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV)
219 REAL(KIND=JPRB) ,INTENT(IN) :: PAKI(KLON,2,NSW)
220 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW)
221 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW)
222 REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV)
223 REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV)
224 REAL(KIND=JPRB) ,INTENT(IN) :: PCLEAR(KLON)
225 REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV)
226 REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV)
227 REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV)
228 REAL(KIND=JPRB) ,INTENT(IN) :: PRMU(KLON)
229 REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON)
230 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV)
231 REAL(KIND=JPRB) ,INTENT(IN) :: PUD(KLON,5,KLEV+1)
232 REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV)
233 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV)
234 LOGICAL ,INTENT(IN) :: LRDUST
235 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV)
236 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV)
237 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV)
238 REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1)
239 REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1)
240 REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1)
241 REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1)
242 REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU2(KLON)
243 REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFF(KLON,KLEV)
244 REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRF(KLON,KLEV)
245 END SUBROUTINE SWNI
246 END INTERFACE
247 INTERFACE
248 SUBROUTINE SWU&
249 & ( KIDIA, KFDIA , KLON , KLEV,&
250 & PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV,&
251 & PAKI , PCLD , PCLEAR, PDSIG, PFACT, PRMU , PSEC , PUD&
252 & )
253 USE PARKIND1 ,ONLY : JPIM ,JPRB
254 USE YOERAD , ONLY : NOVLP
255 include "clesphys.h"
256 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
257 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
258 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
259 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
260 REAL(KIND=JPRB) ,INTENT(IN) :: PSCT
261 REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI
262 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV)
263 REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1)
264 REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON)
265 REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON)
266 REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV)
267 REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV)
268 REAL(KIND=JPRB) ,INTENT(OUT) :: PAKI(KLON,2,NSW)
269 REAL(KIND=JPRB) ,INTENT(INOUT) :: PCLD(KLON,KLEV)
270 REAL(KIND=JPRB) ,INTENT(OUT) :: PCLEAR(KLON)
271 REAL(KIND=JPRB) ,INTENT(OUT) :: PDSIG(KLON,KLEV)
272 REAL(KIND=JPRB) ,INTENT(OUT) :: PFACT(KLON)
273 REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU(KLON)
274 REAL(KIND=JPRB) ,INTENT(OUT) :: PSEC(KLON)
275 REAL(KIND=JPRB) ,INTENT(OUT) :: PUD(KLON,5,KLEV+1)
276 END SUBROUTINE SWU
277 END INTERFACE
278
279 ! ------------------------------------------------------------------
280
281 !* 1. ABSORBER AMOUNTS AND OTHER USEFUL QUANTITIES
282 ! --------------------------------------------
283
284
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('SW',0,ZHOOK_HANDLE)
285 LLDEBUG=.FALSE.
286 CALL SWU ( KIDIA,KFDIA ,KLON ,KLEV,&
287 & PSCT ,PCARDI,PCLDSW,PPMB ,PPSOL,&
288 & PRMU0,PTAVE ,PWV,&
289 120 & ZAKI ,ZCLD ,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD )
290
291 ! ------------------------------------------------------------------
292 !* 2. INTERVAL (0.185/0.25-0.68 MICRON): U.V. AND VISIBLE
293 ! ---------------------------------------------------
294
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (NSW <= 4) THEN
295 INUVS=1
296 INUIR=2
297
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 ELSEIF (NSW == 6) THEN
298 INUVS=1
299 INUIR=4
300 ENDIF
301
302
2/2
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
 4920 DO JK = 1 , KLEV+1
303
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
 4776120 DO JL = KIDIA,KFDIA
304 4771200 ZFD(JL,JK) =0.0_JPRB
305 4771200 ZFU(JL,JK) =0.0_JPRB
306 4771200 ZCD(JL,JK) =0.0_JPRB
307 4776000 ZCU(JL,JK) =0.0_JPRB
308 ENDDO
309 ENDDO
310
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL = KIDIA,KFDIA
311 119280 ZSUDU1T(JL)=0.0_JPRB
312 119280 PUVDF(JL) =0.0_JPRB
313 119280 PPARF(JL) =0.0_JPRB
314 119400 PPARCF(JL) =0.0_JPRB
315 ENDDO
316
317 IF(LLDEBUG) THEN
318 call writefield_phy('sw_zsec',ZSEC,1)
319 call writefield_phy('sw_zrmu',ZRMU,1)
320 call writefield_phy('sw_prmu0',PRMU0,1)
321 call writefield_phy('sw_zfact',ZFACT,1)
322 ENDIF
323
324 120 icount=icount+1
325
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 360 times.
 480 DO JNU = INUVS , INUIR-1
326 !++MODIFCODE
327 CALL SW1S &
328 &( KIDIA , KFDIA, KLON , KLEV , KAER , JNU &
329 &, PAER , PALBD , PALBP, PCG , ZCLD , ZCLEAR &
330 &, ZDSIG, POMEGA, POZ , ZRMU , ZSEC , PTAU , ZUD &
331 &, ZFDUVS,ZFUUVS, ZCDUVS,ZCUUVS, ZSUDU1, ZDIFF,ZDIRF &
332 &, LRDUST,PPIZA_DST(:,:,JNU) & ! SSA for this wavelength
333 &, PCGA_DST(:,:,JNU) & ! GCA for this wavelengt
334 360 &, PTAUREL_DST(:,:,JNU) ) ! TAUREL for this wavelength
335 !--MODIFCODE
336 IF(LLDEBUG) THEN
337 ! Ecriture des champs avec un indicage du fichier par l'intervalle spectral
338 write(str1,'(i1)') jnu
339 call writefield_phy("sw_zcduvs"//str1,zcduvs,klev+1)
340 ENDIF
341
342
343
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 357840 times.
 358200 DO JL=KIDIA,KFDIA
344 357840 PDIFFS(JL,JNU)=ZDIFF(JL,1)*ZFACT(JL)
345 358200 PDIRFS(JL,JNU)=ZDIRF(JL,1)*ZFACT(JL)
346 ENDDO
347
2/2
✓ Branch 0 taken 14400 times.
✓ Branch 1 taken 360 times.
 14760 DO JK = 1 , KLEV+1
348
2/2
✓ Branch 0 taken 14313600 times.
✓ Branch 1 taken 14400 times.
 14328360 DO JL = KIDIA,KFDIA
349 14313600 ZFD(JL,JK)=ZFD(JL,JK)+ZFDUVS(JL,JK)
350 14313600 ZFU(JL,JK)=ZFU(JL,JK)+ZFUUVS(JL,JK)
351 14313600 ZCD(JL,JK)=ZCD(JL,JK)+ZCDUVS(JL,JK)
352 14328000 ZCU(JL,JK)=ZCU(JL,JK)+ZCUUVS(JL,JK)
353 ENDDO
354 ENDDO
355
2/2
✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
 358200 DO JL = KIDIA,KFDIA
356 358200 ZSUDU1T(JL)=ZSUDU1T(JL)+ZSUDU1(JL)
357 ENDDO
358
359
1/2
✓ Branch 0 taken 360 times.
✗ Branch 1 not taken.
 480 IF (NSW == 6) THEN
360
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 240 times.
 360 IF (JNU <= 2) THEN
361
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
 238800 DO JL = KIDIA,KFDIA
362 238800 PUVDF(JL)=PUVDF(JL)+ZFDUVS(JL,1)
363 ENDDO
364 ELSEIF (JNU == 3) THEN
365
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 119280 times.
 119400 DO JL=KIDIA,KFDIA
366 119280 PPARF(JL)=PPARF(JL)+ZFDUVS(JL,1)
367 119400 PPARCF(JL)=PPARCF(JL)+ZCDUVS(JL,1)
368 ENDDO
369 ENDIF
370 ENDIF
371 ENDDO
372
373 !if (icount==5) stop'on arrete dans sw.F90 au bout de 5 appels'
374 ! ------------------------------------------------------------------
375
376 !* 3. INTERVAL (0.68-4.00 MICRON): NEAR-INFRARED
377 ! ------------------------------------------
378
379
2/2
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
 4920 DO JK = 1 , KLEV+1
380
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
 4776120 DO JL = KIDIA,KFDIA
381 4771200 ZFDOWN(JL,JK)=0.0_JPRB
382 4771200 ZFUP (JL,JK)=0.0_JPRB
383 4771200 ZCDOWN(JL,JK)=0.0_JPRB
384 4771200 ZCUP (JL,JK)=0.0_JPRB
385 4776000 ZSUDU2T(JL) =0.0_JPRB
386 ENDDO
387 ENDDO
388
389
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 360 times.
 480 DO JNU = INUIR , NSW
390 !++MODIFCODE
391 CALL SWNI &
392 &( KIDIA ,KFDIA , KLON , KLEV , KAER , JNU &
393 &, PAER ,ZAKI , PALBD, PALBP, PCG , ZCLD, ZCLEAR &
394 &, ZDSIG ,POMEGA, POZ , ZRMU , ZSEC , PTAU, ZUD &
395 &, PWV ,PQS &
396 &, ZFDNIR,ZFUNIR,ZCDNIR,ZCUNIR,ZSUDU2,ZDIFF2,ZDIRF2 &
397 &, LRDUST,PPIZA_DST(:,:,JNU) &
398 &, PCGA_DST(:,:,JNU) &
399 &, PTAUREL_DST(:,:,JNU) &
400 360 &)
401 !--MODIFCODE
402
403 IF(LLDEBUG) THEN
404 ! Ecriture des champs avec un indicage du fichier par l'intervalle spectral
405 write(str1,'(i1)') jnu
406 call writefield_phy("sw_zcdnir"//str1,zcdnir,klev+1)
407 ENDIF
408
409
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 357840 times.
 358200 DO JL=KIDIA,KFDIA
410 357840 PDIFFS(JL,JNU)=ZDIFF2(JL,1)*ZFACT(JL)
411 358200 PDIRFS(JL,JNU)=ZDIRF2(JL,1)*ZFACT(JL)
412 ENDDO
413
2/2
✓ Branch 0 taken 14400 times.
✓ Branch 1 taken 360 times.
 14760 DO JK = 1 , KLEV+1
414
2/2
✓ Branch 0 taken 14313600 times.
✓ Branch 1 taken 14400 times.
 14328360 DO JL = KIDIA,KFDIA
415 14313600 ZFDOWN(JL,JK)=ZFDOWN(JL,JK)+ZFDNIR(JL,JK)
416 14313600 ZFUP (JL,JK)=ZFUP (JL,JK)+ZFUNIR(JL,JK)
417 14313600 ZCDOWN(JL,JK)=ZCDOWN(JL,JK)+ZCDNIR(JL,JK)
418 14328000 ZCUP (JL,JK)=ZCUP (JL,JK)+ZCUNIR(JL,JK)
419 ENDDO
420 ENDDO
421
2/2
✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
 358320 DO JL = KIDIA,KFDIA
422 358200 ZSUDU2T(JL)=ZSUDU2T(JL)+ZSUDU2(JL)
423 ENDDO
424 ENDDO
425
426 ! ------------------------------------------------------------------
427
428 !* 4. FILL THE DIAGNOSTIC ARRAYS
429 ! --------------------------
430
431
2/2
✓ Branch 0 taken 120 times.
✓ Branch 1 taken 119280 times.
 119400 DO JL = KIDIA,KFDIA
432 119280 PFDNN(JL)=ZFDOWN(JL,1)*ZFACT(JL)
433 119280 PFDNV(JL)=ZFD(JL,1)*ZFACT(JL)
434 119280 PFUPN(JL)=ZFUP(JL,KLEV+1)*ZFACT(JL)
435 119280 PFUPV(JL)=ZFU(JL,KLEV+1)*ZFACT(JL)
436
437 119280 PCDNN(JL)=ZCDOWN(JL,1)*ZFACT(JL)
438 119280 PCDNV(JL)=ZCD(JL,1)*ZFACT(JL)
439 119280 PCUPN(JL)=ZCUP(JL,KLEV+1)*ZFACT(JL)
440 119280 PCUPV(JL)=ZCU(JL,KLEV+1)*ZFACT(JL)
441
442 119280 PSUDU(JL)=(ZSUDU1T(JL)+ZSUDU2T(JL))*ZFACT(JL)
443 119280 PUVDF(JL)=PUVDF(JL)*ZFACT(JL)
444 119280 PPARF(JL)=PPARF(JL)*ZFACT(JL)
445 119400 PPARCF(JL)=PPARCF(JL)*ZFACT(JL)
446 ENDDO
447
448 !WRITE(*,'("---> Dans SW:")')
449 !WRITE(*,'("ZFUP ",10E12.5)') (ZFUP(1,JK),JK=1,KLEV+1)
450 !WRITE(*,'("ZFU ",10E12.5)') (ZFU(1,JK),JK=1,KLEV+1)
451 !WRITE(*,'("ZFUNIR",10E12.5)') (ZFUNIR(1,JK),JK=1,KLEV+1)
452 !WRITE(*,'("ZFACT ",E12.5)') ZFACT(1)
453
454
2/2
✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
 4920 DO JK = 1 , KLEV+1
455
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
 4776120 DO JL = KIDIA,KFDIA
456 4771200 PFUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
457 4771200 PFDOWN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
458 4771200 PCUP(JL,JK) = (ZCUP(JL,JK) + ZCU(JL,JK)) * ZFACT(JL)
459 4776000 PCDOWN(JL,JK) = (ZCDOWN(JL,JK) + ZCD(JL,JK)) * ZFACT(JL)
460 ENDDO
461 ENDDO
462 IF(LLDEBUG) THEN
463 call writefield_phy('sw_pcdown',PCDOWN,KLEV+1)
464 ENDIF
465
466 ! ------------------------------------------------------------------
467
468
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('SW',1,ZHOOK_HANDLE)
469 120 END SUBROUTINE SW
470