GCC Code Coverage Report

Directory: ./
File: rad/swclr.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 128 170 75.3%
Branches: 57 82 69.5%
Line Branch Exec Source
1 1440 SUBROUTINE SWCLR &
2 & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,&
3 720 & PAER , PALBP , PDSIG , PRAYL , PSEC,&
4 720 & PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ,&
5 & PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR, &
6 !++MODIFCODE
7 & LDDUST,PPIZA_DST, PCGA_DST, PTAU_DST )
8 !--MODIFCODE
9
10 !**** *SWCLR* - CLEAR-SKY COLUMN COMPUTATIONS
11
12 ! PURPOSE.
13 ! --------
14 ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
15 ! CLEAR-SKY COLUMN
16
17 !** INTERFACE.
18 ! ----------
19
20 ! *SWCLR* IS CALLED EITHER FROM *SW1S*
21 ! OR FROM *SWNI*
22
23 ! IMPLICIT ARGUMENTS :
24 ! --------------------
25
26 ! ==== INPUTS ===
27 ! ==== OUTPUTS ===
28
29 ! METHOD.
30 ! -------
31
32 ! EXTERNALS.
33 ! ----------
34
35 ! NONE
36
37 ! REFERENCE.
38 ! ----------
39
40 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
41 ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
42
43 ! AUTHOR.
44 ! -------
45 ! JEAN-JACQUES MORCRETTE *ECMWF*
46
47 ! MODIFICATIONS.
48 ! --------------
49 ! ORIGINAL : 94-11-15
50 ! Modified : 96-03-19 JJM-PhD (loop 107 in absence of aerosols)
51 ! JJMorcrette 990128 : sunshine duration
52 ! JJMorcrette 990128 : sunshine duration
53 ! 99-05-25 JJMorcrette Revised aerosols
54 ! JJMorcrette 001218 : 6 spectral intervals
55 ! 03-10-10 Deborah Salmond and Marta Janiskova Optimisation
56 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
57 ! A.Grini (Meteo-France: 2005-11-10)
58 ! Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties
59 ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
60 ! O.Boucher fev.2014: modification sur les aerosols pour utiliser les variables DST
61 ! ------------------------------------------------------------------
62
63 USE PARKIND1 ,ONLY : JPIM ,JPRB
64 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
65
66 USE YOESW , ONLY : RTAUA ,RPIZA ,RCGA
67 !USE YOERAD , ONLY : NOVLP ,NSW
68 ! NSW mis dans .def MPL 20140211
69 USE YOERAD , ONLY : NOVLP
70 USE YOERDI , ONLY : REPCLC
71 USE YOERDU , ONLY : REPSCT
72
73 IMPLICIT NONE
74 INCLUDE "clesphys.h"
75
76 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
77 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
78 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
79 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
80 INTEGER(KIND=JPIM),INTENT(IN) :: KAER
81 INTEGER(KIND=JPIM),INTENT(IN) :: KNU
82 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV)
83 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW)
84 REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(KLON,KLEV)
85 REAL(KIND=JPRB) ,INTENT(IN) :: PRAYL(KLON)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON)
87 !++MODIFCODE
88 LOGICAL ,INTENT(IN) :: LDDUST ! flag for DUST
89 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV)
90 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV)
91 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_DST(KLON,KLEV)
92 !--MODIFCODE
93 REAL(KIND=JPRB) ,INTENT(OUT) :: PCGAZ(KLON,KLEV)
94 REAL(KIND=JPRB) ,INTENT(OUT) :: PPIZAZ(KLON,KLEV)
95 REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1)
96 REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1)
97 REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1)
98 REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1)
99 REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1)
100 REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU0(KLON,KLEV+1)
101 REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAZ(KLON,KLEV)
102 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1)
103 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1)
104 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLR(KLON)
105 ! ------------------------------------------------------------------
106
107 !* 0.1 ARGUMENTS
108 ! ---------
109
110 ! ------------------------------------------------------------------
111
112 ! ------------
113
114 1440 REAL(KIND=JPRB) :: ZC0I(KLON,KLEV+1)&
115 1440 & , ZCLE0(KLON,KLEV), ZCLEAR(KLON) &
116 1440 & , ZR21(KLON)&
117 1440 & , ZR23(KLON) , ZSS0(KLON) , ZSCAT(KLON)&
118 1440 & , ZTR(KLON,2,KLEV+1)
119
120 INTEGER(KIND=JPIM) :: IKL, JA, JAE, JAJ, JK, JKL, JKLP1, JKM1, JL, INU1
121
122 REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZDEN, ZDEN1, ZFACOA,&
123 & ZFF, ZGAP, ZGAR, ZMU1, ZMUE, ZRATIO, ZRE11, &
124 & ZTO, ZTRAY, ZWW, ZDENB
125 REAL(KIND=JPRB) :: ZRR,ZMU0,ZI2MU1,ZIMU1,ZIDEN,ZIDEN1
126 REAL(KIND=JPRB) :: ZHOOK_HANDLE
127 !++MODIFCODE
128 1440 REAL(KIND=JPRB) ::ZFACOA_NEW(KLON,KLEV)
129 !--MODIFCODE
130
131
132 ! ------------------------------------------------------------------
133
134 !* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
135 ! --------------------------------------------
136
137
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 IF (LHOOK) CALL DR_HOOK('SWCLR',0,ZHOOK_HANDLE)
138
2/2
✓ Branch 0 taken 28800 times.
✓ Branch 1 taken 720 times.
 29520 DO JK = 1 , KLEV+1
139
2/2
✓ Branch 0 taken 172800 times.
✓ Branch 1 taken 28800 times.
 202320 DO JA = 1 , 6
140
2/2
✓ Branch 0 taken 171763200 times.
✓ Branch 1 taken 172800 times.
 171964800 DO JL = KIDIA,KFDIA
141 171763200 PRJ(JL,JA,JK) = 0.0_JPRB
142 171936000 PRK(JL,JA,JK) = 0.0_JPRB
143 ENDDO
144 ENDDO
145 ENDDO
146
147 ! ------ NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
148
149
2/2
✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
 28800 DO JK = 1 , KLEV
150 28080 IKL=KLEV+1-JK
151
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27939600 DO JL = KIDIA,KFDIA
152 27911520 PCGAZ(JL,JK) = 0.0_JPRB
153 27911520 PPIZAZ(JL,JK) = 0.0_JPRB
154 27911520 PTAUAZ(JL,JK) = 0.0_JPRB
155 27939600 ZFACOA_NEW(JL,JK) = 0.0_JPRB
156 ENDDO
157
158 !++MODIFCODE
159 !--OB on fait passer les aerosols LMDZ dans la variable DST
160
1/2
✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
 28080 IF(NOVLP < 5)THEN !ECMWF VERSION
161 ! DO JAE=1,6
162
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27939600 DO JL = KIDIA,KFDIA
163 ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL,JAE,IKL)*RTAUA(KNU,JAE)
164 27911520 PTAUAZ(JL,JK)=PTAU_DST(JL,IKL)
165 ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JAE,IKL)&
166 ! & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
167 27911520 PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)
168 ! PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JAE,IKL)&
169 ! & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
170 27939600 PCGAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
171 ENDDO
172 ! ENDDO
173 ELSE ! MESONH VERSION
174 !--OB on utilise directement les aerosols LMDZ
175 ! DO JAE=1,6
176 ✗ DO JL = KIDIA,KFDIA
177 !Special optical properties for dust
178 ! IF (LDDUST.AND.(JAE==3)) THEN
179 !Ponderation of aerosol optical properties:first step
180 !ti
181 ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK) + PAER(JL,JAE,IKL) * PTAUREL_DST(JL,IKL)
182 ✗ PTAUAZ(JL,JK)= PTAU_DST(JL,IKL)
183 !wi*ti
184 ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK) + PAER(JL,JAE,IKL) &
185 ! & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)
186 ✗ PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)
187 !wi*ti*gi
188 ! PCGAZ(JL,JK) = PCGAZ(JL,JK) + PAER(JL,JAE,IKL) &
189 ! & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
190 ✗ PCGAZ(JL,JK) = PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
191 !wi*ti*(gi**2)
192 ! ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
193 ! & *PTAUREL_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
194 ! & PCGA_DST(JL,IKL)
195 ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+&
196 & PTAU_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
197 ✗ & PCGA_DST(JL,IKL)
198 ! ELSE
199 !Ponderation of aerosol optical properties:first step
200 !ti
201 ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE)
202 !wi*ti
203 ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)&
204 ! &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
205 !wi*ti*gi
206 ! PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL, JAE, IKL)&
207 ! &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
208 !wi*ti*(gi**2)
209 ! ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
210 ! &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)*RCGA(KNU,JAE)
211 ! ENDIF
212 ENDDO
213 ! ENDDO
214 ENDIF
215 !--MODIFCODE
216
217 !++MODIFCODE
218
1/2
✓ Branch 0 taken 28080 times.
✗ Branch 1 not taken.
 28800 IF (NOVLP < 5) then !ECMWF VERSION
219
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27939600 DO JL = KIDIA,KFDIA
220
1/2
✓ Branch 0 taken 27911520 times.
✗ Branch 1 not taken.
 27939600 IF (KAER /= 0) THEN
221 27911520 PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
222 27911520 PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
223 !!!! wrong ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
224 !--
225 ZGAR = PCGAZ(JL,JK)
226 27911520 ZFF = ZGAR * ZGAR
227
228 !-- bug-fix: ZRATIO must be defined from the transformed value of optical thickness
229 ! MPLFH : ZTRAY N'EST PAS INITIALISE !!!!! A REVOIR (MPL)
230 27911520 ZTRAY= PRAYL(JL) * PDSIG(JL,JK)
231 ! print *,'>>>>>>> swclr: ZTRAY ',ZTRAY
232 27911520 ZDENB = ZTRAY + PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF)
233 27911520 ZRATIO=ZTRAY/ZDENB
234 !--
235 27911520 PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF)
236 27911520 PCGAZ(JL,JK) = ZGAR * (1.0_JPRB - ZRATIO) / (1.0_JPRB + ZGAR)
237 PPIZAZ(JL,JK) =ZRATIO+(1.0_JPRB-ZRATIO)*PPIZAZ(JL,JK)*(1.0_JPRB-ZFF)&
238 27911520 & / (1.0_JPRB - PPIZAZ(JL,JK) * ZFF)
239 ELSE
240 ✗ ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
241 ✗ PTAUAZ(JL,JK) = ZTRAY
242 ✗ PCGAZ(JL,JK) = 0.0_JPRB
243 ✗ PPIZAZ(JL,JK) = 1.0_JPRB-REPSCT
244 ENDIF
245 ENDDO
246 ELSE !MESONH VERSION
247 ✗ DO JL = KIDIA,KFDIA
248 ✗ IF (KAER /= 0) THEN
249 ✗ ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
250 ✗ ZRATIO =PPIZAZ(JL,JK)+ZTRAY
251 !Ponderation G**2
252 ✗ ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)/ZRATIO
253 !Ponderation w
254 ✗ PPIZAZ(JL,JK)=ZRATIO/(PTAUAZ(JL,JK)+ZTRAY)
255 !Ponderation g
256 ✗ PCGAZ(JL,JK)=PCGAZ(JL,JK)/ZRATIO
257 !Ponderation+delta-modified parameters tau
258 PTAUAZ(JL,JK)=(ZTRAY+PTAUAZ(JL,JK))*&
259 ✗ & (1.0_JPRB-PPIZAZ(JL,JK)*ZFACOA_NEW(JL,JK))
260 !delta-modified parameters w
261 PPIZAZ(JL,JK)=PPIZAZ(JL,JK)*(1.0_JPRB-ZFACOA_NEW(JL,JK))/&
262 ✗ & (1.0_JPRB-ZFACOA_NEW(JL,JK)*PPIZAZ(JL,JK))
263 !delta-modified parameters g
264 ✗ PCGAZ(JL,JK)=PCGAZ(JL,JK)/(1.0_JPRB+PCGAZ(JL,JK))
265
266 ELSE
267 ✗ ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
268 ✗ ZFACOA_NEW(JL,JK)= 0.0_JPRB
269 ✗ PTAUAZ(JL,JK) = ZTRAY
270 ✗ PCGAZ(JL,JK) = 0.0_JPRB
271 ✗ PPIZAZ(JL,JK) = 1.0_JPRB-REPSCT
272 ENDIF
273 ENDDO
274 ENDIF
275 !--MODIFCODE
276
277 ENDDO
278
279 ! ------------------------------------------------------------------
280
281 !* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
282 ! ----------------------------------------------
283
284
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
285 715680 ZR23(JL) = 0.0_JPRB
286 715680 ZC0I(JL,KLEV+1) = 0.0_JPRB
287 715680 ZCLEAR(JL) = 1.0_JPRB
288 716400 ZSCAT(JL) = 0.0_JPRB
289 ENDDO
290
291 JK = 1
292 JKL = KLEV+1 - JK
293 JKLP1 = JKL + 1
294
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
295 !++MODIFCODE
296
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 715680 times.
 715680 IF (NOVLP >= 5) THEN
297 ✗ ZFACOA = PTAUAZ(JL,JK)
298 ✗ ZCORAE = ZFACOA * PSEC(JL)
299 ELSE
300 715680 ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
301 715680 ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
302 ENDIF
303 !--MODIFCODE
304 715680 ZR21(JL) = EXP(-ZCORAE )
305 715680 ZSS0(JL) = 1.0_JPRB-ZR21(JL)
306 715680 ZCLE0(JL,JKL) = ZSS0(JL)
307
308
1/2
✓ Branch 0 taken 715680 times.
✗ Branch 1 not taken.
 716400 IF (NOVLP == 1 .OR. NOVLP == 4) THEN
309 !* maximum-random
310 ZCLEAR(JL) = ZCLEAR(JL)&
311 & *(1.0_JPRB-MAX(ZSS0(JL),ZSCAT(JL)))&
312 715680 & /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC))
313 715680 ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL)
314 715680 ZSCAT(JL) = ZSS0(JL)
315 ✗ ELSEIF (NOVLP == 2) THEN
316 !* maximum
317 ✗ ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
318 ✗ ZC0I(JL,JKL) = ZSCAT(JL)
319 !++MODIFCODE
320 ✗ ELSEIF ((NOVLP == 3).OR.(NOVLP >= 5)) THEN
321 !--MODIFCODE
322 !* random
323 ✗ ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-ZSS0(JL))
324 ✗ ZSCAT(JL) = 1.0_JPRB - ZCLEAR(JL)
325 ✗ ZC0I(JL,JKL) = ZSCAT(JL)
326 ENDIF
327 ENDDO
328
329
2/2
✓ Branch 0 taken 27360 times.
✓ Branch 1 taken 720 times.
 28080 DO JK = 2 , KLEV
330 27360 JKL = KLEV+1 - JK
331 JKLP1 = JKL + 1
332
2/2
✓ Branch 0 taken 27195840 times.
✓ Branch 1 taken 27360 times.
 27223920 DO JL = KIDIA,KFDIA
333 !++MODIFCODE
334
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 27195840 times.
 27195840 IF (NOVLP >= 5) THEN
335 ✗ ZFACOA = PTAUAZ(JL,JK)
336 ✗ ZCORAE = ZFACOA * PSEC(JL)
337 ELSE
338 27195840 ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
339 27195840 ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
340 ENDIF
341 !--MODIFCODE
342 27195840 ZR21(JL) = EXP(-ZCORAE )
343 27195840 ZSS0(JL) = 1.0_JPRB-ZR21(JL)
344 27195840 ZCLE0(JL,JKL) = ZSS0(JL)
345
346
1/2
✓ Branch 0 taken 27195840 times.
✗ Branch 1 not taken.
 27223200 IF (NOVLP == 1 .OR. NOVLP == 4) THEN
347 !* maximum-random
348 ZCLEAR(JL) = ZCLEAR(JL)&
349 & *(1.0_JPRB-MAX(ZSS0(JL),ZSCAT(JL)))&
350 27195840 & /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC))
351 27195840 ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL)
352 27195840 ZSCAT(JL) = ZSS0(JL)
353 ✗ ELSEIF (NOVLP == 2) THEN
354 !* maximum
355 ✗ ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
356 ✗ ZC0I(JL,JKL) = ZSCAT(JL)
357 !++MODIFCODE
358 ✗ ELSEIF ((NOVLP == 3).OR.(NOVLP >= 5)) THEN
359 !--MODIFCODE
360 !* random
361 ✗ ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-ZSS0(JL))
362 ✗ ZSCAT(JL) = 1.0_JPRB - ZCLEAR(JL)
363 ✗ ZC0I(JL,JKL) = ZSCAT(JL)
364 ENDIF
365 ENDDO
366 ENDDO
367
368 ! ------------------------------------------------------------------
369
370 !* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
371 ! -----------------------------------------------
372
373
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
374 715680 PRAY1(JL,KLEV+1) = 0.0_JPRB
375 715680 PRAY2(JL,KLEV+1) = 0.0_JPRB
376 715680 PREFZ(JL,2,1) = PALBP(JL,KNU)
377 715680 PREFZ(JL,1,1) = PALBP(JL,KNU)
378 715680 PTRA1(JL,KLEV+1) = 1.0_JPRB
379 716400 PTRA2(JL,KLEV+1) = 1.0_JPRB
380 ENDDO
381
382
2/2
✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
 28800 DO JK = 2 , KLEV+1
383 28080 JKM1 = JK-1
384
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27940320 DO JL = KIDIA,KFDIA
385
386 ! ------------------------------------------------------------------
387
388 !* 3.1 EQUIVALENT ZENITH ANGLE
389 ! -----------------------
390
391 27911520 ZMUE = (1.0_JPRB-ZC0I(JL,JK)) * PSEC(JL)+ ZC0I(JL,JK) * 1.66_JPRB
392 27911520 PRMU0(JL,JK) = 1.0_JPRB/ZMUE
393 ZMU0=PRMU0(JL,JK)
394
395 ! ------------------------------------------------------------------
396
397 !* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
398 ! ----------------------------------------------------
399
400 27911520 ZGAP = PCGAZ(JL,JKM1)
401 27911520 ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP *ZMU0
402 27911520 ZWW = PPIZAZ(JL,JKM1)
403 27911520 ZTO = PTAUAZ(JL,JKM1)
404 ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
405 27911520 & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
406 27911520 ZIDEN=1.0_JPRB / ZDEN
407 27911520 PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN
408 27911520 PTRA1(JL,JKM1) = ZIDEN
409
410 ZMU1 = 0.5_JPRB
411 ZIMU1=2.0_JPRB
412 ZI2MU1=4.0_JPRB
413 27911520 ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1
414 ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 &
415 27911520 & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1
416 27911520 ZIDEN1=1.0_JPRB / ZDEN1
417 27911520 PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 *ZIDEN1
418 27911520 PTRA2(JL,JKM1) = ZIDEN1
419
420 27911520 ZRR=1.0_JPRB/(1.0_JPRB-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))
421 PREFZ(JL,1,JK) = PRAY1(JL,JKM1)&
422 & + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
423 & * PTRA2(JL,JKM1)&
424 27911520 & *ZRR
425
426 ZTR(JL,1,JKM1) = PTRA1(JL,JKM1)&
427 27911520 & *ZRR
428
429 PREFZ(JL,2,JK) = PRAY1(JL,JKM1)&
430 & + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
431 27911520 & * PTRA2(JL,JKM1)
432
433 27939600 ZTR(JL,2,JKM1) = PTRA1(JL,JKM1)
434
435 ENDDO
436 ENDDO
437
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
438 715680 ZMUE = (1.0_JPRB-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66_JPRB
439 715680 PRMU0(JL,1)=1.0_JPRB/ZMUE
440 716400 PTRCLR(JL)=1.0_JPRB-ZC0I(JL,1)
441 ENDDO
442
443 ! ------------------------------------------------------------------
444
445 !* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
446 ! -------------------------------------------------
447
448
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 IF (NSW <= 4) THEN
449 INU1=1
450
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 ELSEIF (NSW == 6) THEN
451 INU1=3
452 ENDIF
453
454
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 360 times.
 720 IF (KNU <= INU1) THEN
455 JAJ = 2
456
2/2
✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
 358200 DO JL = KIDIA,KFDIA
457 357840 PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
458 358200 PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
459 ENDDO
460
461
2/2
✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
 14400 DO JK = 1 , KLEV
462 14040 JKL = KLEV+1 - JK
463 14040 JKLP1 = JKL + 1
464
2/2
✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
 13970160 DO JL = KIDIA,KFDIA
465 13955760 ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL)
466 13955760 PRJ(JL,JAJ,JKL) = ZRE11
467 13969800 PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL)
468 ENDDO
469 ENDDO
470
471 ELSE
472
473
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 720 times.
 1080 DO JAJ = 1 , 2
474
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
475 715680 PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
476 716400 PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
477 ENDDO
478
479
2/2
✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
 29160 DO JK = 1 , KLEV
480 28080 JKL = KLEV+1 - JK
481 28080 JKLP1 = JKL + 1
482
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27940320 DO JL = KIDIA,KFDIA
483 27911520 ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
484 27911520 PRJ(JL,JAJ,JKL) = ZRE11
485 27939600 PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
486 ENDDO
487 ENDDO
488 ENDDO
489
490 ENDIF
491
492 ! ------------------------------------------------------------------
493
494
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 IF (LHOOK) CALL DR_HOOK('SWCLR',1,ZHOOK_HANDLE)
495 720 END SUBROUTINE SWCLR
496