GCC Code Coverage Report

Directory: ./
File: rad/swr.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 139 175 79.4%
Branches: 52 76 68.4%
Line Branch Exec Source
1 1440 SUBROUTINE SWR &
2 & ( KIDIA , KFDIA , KLON , KLEV , KNU,&
3 720 & PALBD , PCG , PCLD , POMEGA, PSEC , PTAU,&
4 720 & PCGAZ , PPIZAZ, PRAY1, PRAY2 , PREFZ, PRJ , PRK , PRMUE,&
5 720 & PTAUAZ, PTRA1 , PTRA2, PTRCLD &
6 & )
7
8 !**** *SWR* - CONTINUUM SCATTERING COMPUTATIONS
9
10 ! PURPOSE.
11 ! --------
12 ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
13 ! CONTINUUM SCATTERING
14
15 !** INTERFACE.
16 ! ----------
17
18 ! *SWR* IS CALLED EITHER FROM *SW1S*
19 ! OR FROM *SWNI*
20
21 ! IMPLICIT ARGUMENTS :
22 ! --------------------
23
24 ! ==== INPUTS ===
25 ! ==== OUTPUTS ===
26
27 ! METHOD.
28 ! -------
29
30 ! 1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
31 ! OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)
32
33 ! EXTERNALS.
34 ! ----------
35
36 ! *SWDE*
37
38 ! REFERENCE.
39 ! ----------
40
41 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
42 ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
43
44 ! AUTHOR.
45 ! -------
46 ! JEAN-JACQUES MORCRETTE *ECMWF*
47
48 ! MODIFICATIONS.
49 ! --------------
50 ! ORIGINAL : 89-07-14
51 ! Ph. DANDIN Meteo-France 05-96 : Effect of cloud layer
52 ! JJMorcrette 990128 : sunshine duration
53 ! JJMorcrette 001218 : 6 spectral intervals
54 ! 03-10-10 Deborah Salmond and Marta Janiskova Optimisation
55 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
56 ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
57 ! ------------------------------------------------------------------
58
59 USE PARKIND1 ,ONLY : JPIM ,JPRB
60 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
61
62 !USE YOERAD , ONLY : NOVLP ,NSW
63 ! NSW mis dans ;def MPL 20140211
64 USE YOERAD , ONLY : NOVLP
65 USE YOECLD , ONLY : REPSEC
66 USE YOEOVLP , ONLY : RA1OVLP
67 USE write_field_phy
68
69 IMPLICIT NONE
70
71 include "clesphys.h"
72 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
73 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
74 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
75 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
76 INTEGER(KIND=JPIM),INTENT(IN) :: KNU
77 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW)
78 REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV)
79 REAL(KIND=JPRB) ,INTENT(IN) :: PCLD(KLON,KLEV)
80 REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV)
81 REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(KLON)
82 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV)
83 REAL(KIND=JPRB) ,INTENT(IN) :: PCGAZ(KLON,KLEV)
84 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZAZ(KLON,KLEV)
85 REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(KLON,KLEV+1)
86 REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(KLON,KLEV+1)
87 REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(KLON,2,KLEV+1)
88 REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(KLON,6,KLEV+1)
89 REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(KLON,6,KLEV+1)
90 REAL(KIND=JPRB) ,INTENT(OUT) :: PRMUE(KLON,KLEV+1)
91 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUAZ(KLON,KLEV)
92 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(KLON,KLEV+1)
93 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(KLON,KLEV+1)
94 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLD(KLON)
95 ! ------------------------------------------------------------------
96
97 !* 0.1 ARGUMENTS
98 ! ---------
99
100 ! ------------------------------------------------------------------
101
102 ! ------------
103
104 1440 REAL(KIND=JPRB) :: ZC1I(KLON,KLEV+1) , ZCLEQ(KLON,KLEV)&
105 1440 & , ZCLEAR(KLON) , ZCLOUD(KLON) &
106 1440 & , ZGG(KLON) , ZREF(KLON)&
107 1440 & , ZRE1(KLON) , ZRE2(KLON)&
108 1440 & , ZRMUZ(KLON) , ZRNEB(KLON)&
109 1440 & , ZR21(KLON) , ZR22(KLON)&
110 1440 & , ZR23(KLON) , ZSS1(KLON)&
111 1440 & , ZTO1(KLON) , ZTR(KLON,2,KLEV+1)&
112 1440 & , ZTR1(KLON) , ZTR2(KLON)&
113 1440 & , ZW(KLON)
114
115 INTEGER(KIND=JPIM) :: IKL, IKLP1, JA, JAJ, JK, JKM1, JL, INU1
116
117 REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZCORCD, ZDEN, ZDEN1,&
118 & ZFACOA, ZFACOC, ZGAP, ZMU1, ZMUE, ZRE11, &
119 & ZTO, ZWW, ZALPHA1, ZCHKAE, ZCHKCD
120 REAL(KIND=JPRB) :: ZRR,ZIMU1,ZI2MU1,ZIDEN,ZIDEN1
121 REAL(KIND=JPRB) :: ZHOOK_HANDLE
122 LOGICAL :: LLDEBUG
123
124 INTERFACE
125 SUBROUTINE SWDE&
126 & ( KIDIA, KFDIA, KLON,&
127 & PGG , PREF , PRMUZ, PTO1, PW,&
128 & PRE1 , PRE2 , PTR1 , PTR2&
129 & )
130 USE PARKIND1 ,ONLY : JPIM ,JPRB
131 USE YOMJFH , ONLY : N_VMASS
132 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
133 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
134 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
135 REAL(KIND=JPRB) ,INTENT(IN) :: PGG(KLON)
136 REAL(KIND=JPRB) ,INTENT(IN) :: PREF(KLON)
137 REAL(KIND=JPRB) ,INTENT(IN) :: PRMUZ(KLON)
138 REAL(KIND=JPRB) ,INTENT(IN) :: PTO1(KLON)
139 REAL(KIND=JPRB) ,INTENT(IN) :: PW(KLON)
140 REAL(KIND=JPRB) ,INTENT(OUT) :: PRE1(KLON)
141 REAL(KIND=JPRB) ,INTENT(OUT) :: PRE2(KLON)
142 REAL(KIND=JPRB) ,INTENT(OUT) :: PTR1(KLON)
143 REAL(KIND=JPRB) ,INTENT(OUT) :: PTR2(KLON)
144 END SUBROUTINE SWDE
145 END INTERFACE
146
147 ! ------------------------------------------------------------------
148
149 !* 1. INITIALIZATION
150 ! --------------
151
152
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 IF (LHOOK) CALL DR_HOOK('SWR',0,ZHOOK_HANDLE)
153 LLDEBUG=.FALSE.
154
2/2
✓ Branch 0 taken 28800 times.
✓ Branch 1 taken 720 times.
 29520 DO JK = 1 , KLEV+1
155
2/2
✓ Branch 0 taken 172800 times.
✓ Branch 1 taken 28800 times.
 202320 DO JA = 1 , 6
156
2/2
✓ Branch 0 taken 171763200 times.
✓ Branch 1 taken 172800 times.
 171964800 DO JL = KIDIA,KFDIA
157 171763200 PRJ(JL,JA,JK) = 0.0_JPRB
158 171936000 PRK(JL,JA,JK) = 0.0_JPRB
159 ENDDO
160 ENDDO
161 ENDDO
162
163 720 REPSEC=1.E-12_JPRB !!!!! A REVOIR (MPL) 220109
164
165 ! ------------------------------------------------------------------
166
167 !* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
168 ! ----------------------------------------------
169
170
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
171 715680 ZR23(JL) = 0.0_JPRB
172 715680 ZC1I(JL,KLEV+1) = 0.0_JPRB
173 715680 ZCLEAR(JL) = 1.0_JPRB
174 716400 ZCLOUD(JL) = 0.0_JPRB
175 ENDDO
176
177 JK = 1
178 IKL = KLEV+1 - JK
179 IKLP1 = IKL + 1
180 ZALPHA1=RA1OVLP( IKL )
181
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
182 !++MODIFCODE
183
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 715680 times.
 715680 IF (NOVLP >= 5) THEN !MESONH VERSION
184 ✗ stop 'provisoire pour verifier option novlp=1'
185 ZFACOA =PTAUAZ(JL,IKL)
186 ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
187 ZCORAE = ZFACOA * PSEC(JL)
188 ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
189 ELSE !ECMWF VERSION
190 715680 ZFACOA = 1.0_JPRB - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
191 715680 ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
192 715680 ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
193 715680 ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
194 ENDIF
195 !--MODIFCODE
196 715680 ZCHKAE = MIN( 200._JPRB, ZCORAE )
197 715680 ZCHKCD = MIN( 200._JPRB, ZCORCD )
198 715680 ZR21(JL) = EXP( - ZCHKAE )
199 715680 ZR22(JL) = EXP( - ZCHKCD )
200
201 ZSS1(JL) = PCLD(JL,IKL)*(1.0_JPRB-ZR21(JL)*ZR22(JL))&
202 715680 & + (1.0_JPRB-PCLD(JL,IKL))*(1.0_JPRB-ZR21(JL))
203 715680 ZCLEQ(JL,IKL) = ZSS1(JL)
204
205 !++MODIFCODE
206
1/2
✓ Branch 0 taken 715680 times.
✗ Branch 1 not taken.
 716400 IF ((NOVLP == 1).OR.(NOVLP == 8)) THEN
207 !--MODIFCODE
208 !* maximum-random
209 ZCLEAR(JL) = ZCLEAR(JL)&
210 & *(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL)))&
211 715680 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC))
212 715680 ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
213 715680 ZCLOUD(JL) = ZSS1(JL)
214 ✗ ELSEIF (NOVLP == 2) THEN
215 !IM150716 stop 'provisoire pour verifier option novlp=1b'
216 ✗ print*,'rrtm provisoire pour verifier option novlp=2 maximum'
217 !* maximum
218 ✗ ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
219 ✗ ZC1I(JL,IKL) = ZCLOUD(JL)
220 !++MODIFCODE
221 ✗ ELSEIF ((NOVLP == 3).OR.((NOVLP >= 5).AND.(NOVLP /= 8))) THEN
222 !IM150716 stop 'provisoire pour verifier option novlp=1c'
223 ✗ print*,'rrtm provisoire pour verifier option novlp=3 random'
224 !--MODIFCODE
225 !* random
226 ✗ ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - ZSS1(JL))
227 ✗ ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
228 ✗ ZC1I(JL,IKL) = ZCLOUD(JL)
229 ✗ ELSEIF (NOVLP == 4) THEN
230 ✗ stop 'provisoire pour verifier option novlp=1d'
231 !* Hogan & Illingworth, 2001
232 ZCLEAR(JL)=ZCLEAR(JL)*( &
233 & ZALPHA1*(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL))) &
234 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
235 & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-ZSS1(JL)) )
236 ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
237 ZCLOUD(JL) = ZSS1(JL)
238 ENDIF
239 ENDDO
240
241
2/2
✓ Branch 0 taken 27360 times.
✓ Branch 1 taken 720 times.
 28080 DO JK = 2 , KLEV
242 27360 IKL = KLEV+1 - JK
243 IKLP1 = IKL + 1
244 27360 ZALPHA1=RA1OVLP( IKL )
245
2/2
✓ Branch 0 taken 27195840 times.
✓ Branch 1 taken 27360 times.
 27223920 DO JL = KIDIA,KFDIA
246 !++MODIFCODE
247
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 27195840 times.
 27195840 IF (NOVLP >= 5) THEN !MESONH VERSION
248 ✗ ZFACOA =PTAUAZ(JL,IKL)
249 ✗ ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
250 ✗ ZCORAE = ZFACOA * PSEC(JL)
251 ✗ ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
252 ELSE !ECMWF VERSION
253 27195840 ZFACOA = 1.0_JPRB - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
254 27195840 ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
255 27195840 ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
256 27195840 ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
257 ENDIF
258 !--MODIFCODE
259 ! ZR21(JL) = EXP(-ZCORAE )
260 ! ZR22(JL) = EXP(-ZCORCD )
261
262 27195840 ZCHKAE = MIN( 200._JPRB, ZCORAE )
263 27195840 ZCHKCD = MIN( 200._JPRB, ZCORCD )
264 27195840 ZR21(JL) = EXP( - ZCHKAE )
265 27195840 ZR22(JL) = EXP( - ZCHKCD )
266
267 ZSS1(JL) = PCLD(JL,IKL)*(1.0_JPRB-ZR21(JL)*ZR22(JL))&
268 27195840 & + (1.0_JPRB-PCLD(JL,IKL))*(1.0_JPRB-ZR21(JL))
269 27195840 ZCLEQ(JL,IKL) = ZSS1(JL)
270
271 !++MODIFCODE
272
1/2
✓ Branch 0 taken 27195840 times.
✗ Branch 1 not taken.
 27223200 IF ((NOVLP == 1).OR.(NOVLP == 8)) THEN
273 !--MODIFCODE
274 !* maximum-random
275 ZCLEAR(JL) = ZCLEAR(JL)&
276 & *(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL)))&
277 27195840 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC))
278 27195840 ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
279 27195840 ZCLOUD(JL) = ZSS1(JL)
280 ✗ ELSEIF (NOVLP == 2) THEN
281 !* maximum
282 ✗ ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
283 ✗ ZC1I(JL,IKL) = ZCLOUD(JL)
284 !++MODIFCODE
285 ✗ ELSEIF ((NOVLP == 3).OR.((NOVLP >= 5).AND.(NOVLP /= 8))) THEN
286 !--MODIFCODE
287 !* random
288 ✗ ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - ZSS1(JL))
289 ✗ ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
290 ✗ ZC1I(JL,IKL) = ZCLOUD(JL)
291 ✗ ELSEIF (NOVLP == 4) THEN
292 !* Hogan & Illingworth, 2001
293 ZCLEAR(JL)=ZCLEAR(JL)*( &
294 & ZALPHA1*(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL))) &
295 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
296 ✗ & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-ZSS1(JL)) )
297 ✗ ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
298 ✗ ZCLOUD(JL) = ZSS1(JL)
299 ENDIF
300 ENDDO
301 ENDDO
302
303 ! ------------------------------------------------------------------
304
305 !* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
306 ! -----------------------------------------------
307
308
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
309 715680 PRAY1(JL,KLEV+1) = 0.0_JPRB
310 715680 PRAY2(JL,KLEV+1) = 0.0_JPRB
311 715680 PREFZ(JL,2,1) = PALBD(JL,KNU)
312 715680 PREFZ(JL,1,1) = PALBD(JL,KNU)
313 715680 PTRA1(JL,KLEV+1) = 1.0_JPRB
314 716400 PTRA2(JL,KLEV+1) = 1.0_JPRB
315 ENDDO
316
317
2/2
✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
 28800 DO JK = 2 , KLEV+1
318 28080 JKM1 = JK-1
319
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27939600 DO JL = KIDIA,KFDIA
320 27911520 ZRNEB(JL)= PCLD(JL,JKM1)
321 27911520 ZRE1(JL)=0.0_JPRB
322 27911520 ZTR1(JL)=0.0_JPRB
323 27911520 ZRE2(JL)=0.0_JPRB
324 27911520 ZTR2(JL)=0.0_JPRB
325
326 ! ------------------------------------------------------------------
327
328 !* 3.1 EQUIVALENT ZENITH ANGLE
329 ! -----------------------
330
331 27911520 ZMUE = (1.0_JPRB-ZC1I(JL,JK)) * PSEC(JL)+ ZC1I(JL,JK) * 1.66_JPRB
332 27911520 PRMUE(JL,JK) = 1.0_JPRB/ZMUE
333
334 ! ------------------------------------------------------------------
335
336 !* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
337 ! ----------------------------------------------------
338
339 27911520 ZGAP = PCGAZ(JL,JKM1)
340 27911520 ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP / ZMUE
341 27911520 ZWW = PPIZAZ(JL,JKM1)
342 27911520 ZTO = PTAUAZ(JL,JKM1)
343 ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
344 27911520 & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
345 27911520 ZIDEN=1.0_JPRB/ZDEN
346 27911520 PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN
347 27911520 PTRA1(JL,JKM1) = ZIDEN
348
349 ZMU1 = 0.5_JPRB
350 ZIMU1=2.0_JPRB
351 ZI2MU1=4.0_JPRB
352 27911520 ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1
353 ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 &
354 27911520 & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1
355 27911520 ZIDEN1=1.0_JPRB/ZDEN1
356 27911520 PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 * ZIDEN1
357 27911520 PTRA2(JL,JKM1) = ZIDEN1
358
359 ! ------------------------------------------------------------------
360
361 !* 3.3 EFFECT OF CLOUD LAYER
362 ! ---------------------
363
364
365 !++MODIFCODE
366
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 27911520 times.
 27911520 IF (NOVLP >= 5)THEN !MESONH VERSION
367 ✗ ZW(JL) =PCG(JL,KNU,JKM1)*PCG(JL,KNU,JKM1)
368 ✗ ZTO1(JL) = PTAU(JL,KNU,JKM1)*(1-(POMEGA(JL,KNU,JKM1)*ZW(JL)))
369 ✗ ZW(JL) =POMEGA(JL,KNU,JKM1)*(1-ZW(JL))/(1-(POMEGA(JL,KNU,JKM1)*ZW(JL)))
370 ✗ ZGG(JL) = PCG(JL,KNU,JKM1)/(1+PCG(JL,KNU,JKM1))
371 ✗ ZGG(JL)=ZTO1(JL)*ZW(JL)*ZGG(JL)+PTAUAZ(JL,JKM1)*PPIZAZ(JL,JKM1)*PCGAZ(JL,JKM1)
372 ✗ ZW(JL) =ZTO1(JL)*ZW(JL)+PTAUAZ(JL,JKM1)*PPIZAZ(JL,JKM1)
373 ✗ ZTO1(JL) = ZTO1(JL) + PTAUAZ(JL,JKM1)
374 ✗ ZGG(JL)=ZGG(JL)/ZW(JL)
375 ✗ ZW(JL) =ZW(JL)/ZTO1(JL)
376 ELSE !ECMWF VERSION
377 27911520 ZW(JL) = POMEGA(JL,KNU,JKM1)
378 27911520 ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL)+ PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1)
379 27911520 ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1)
380 27911520 ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
381 ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)&
382 27911520 & + (1.0_JPRB - ZR22(JL)) * PCGAZ(JL,JKM1)
383
3/4
✓ Branch 0 taken 21359298 times.
✓ Branch 1 taken 6552222 times.
✓ Branch 2 taken 21359298 times.
✗ Branch 3 not taken.
 27911520 IF (ZW(JL) == 1.0_JPRB .AND. PPIZAZ(JL,JKM1) == 1.0_JPRB) THEN
384 21359298 ZW(JL)=1.0_JPRB
385 ELSE
386 6552222 ZW(JL) = ZR21(JL) / ZTO1(JL)
387 ENDIF
388 ENDIF
389 !--MODIFCODE
390 27911520 ZREF(JL) = PREFZ(JL,1,JKM1)
391 27939600 ZRMUZ(JL) = PRMUE(JL,JK)
392 ENDDO
393
394 CALL SWDE ( KIDIA, KFDIA , KLON,&
395 & ZGG , ZREF , ZRMUZ , ZTO1 , ZW,&
396 28080 & ZRE1 , ZRE2 , ZTR1 , ZTR2 )
397
398
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27940320 DO JL = KIDIA,KFDIA
399
400 27911520 ZRR=1.0_JPRB/(1.0_JPRB-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))
401
402 PREFZ(JL,1,JK) = (1.0_JPRB-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
403 & + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
404 & * PTRA2(JL,JKM1)&
405 & * ZRR ) &
406 27911520 & + ZRNEB(JL) * ZRE2(JL)
407
408 ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1)&
409 & * ZRR ) &
410 27911520 & * (1.0_JPRB-ZRNEB(JL))
411
412 PREFZ(JL,2,JK) = (1.0_JPRB-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
413 & + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
414 & * PTRA2(JL,JKM1) )&
415 27911520 & + ZRNEB(JL) * ZRE1(JL)
416
417 27939600 ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)+ PTRA1(JL,JKM1) * (1.0_JPRB-ZRNEB(JL))
418
419 ENDDO
420 ENDDO
421
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
422 715680 ZMUE = (1.0_JPRB-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66_JPRB
423 715680 PRMUE(JL,1)=1.0_JPRB/ZMUE
424 716400 PTRCLD(JL)=1.0_JPRB-ZC1I(JL,1)
425 ENDDO
426
427 ! ------------------------------------------------------------------
428
429 !* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
430 ! -------------------------------------------------
431
432
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 IF (NSW <= 4) THEN
433 INU1=1
434
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 ELSEIF (NSW == 6) THEN
435 INU1=3
436 ENDIF
437
438
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 360 times.
 720 IF (KNU <= INU1) THEN
439 JAJ = 2
440
2/2
✓ Branch 0 taken 357840 times.
✓ Branch 1 taken 360 times.
 358200 DO JL = KIDIA,KFDIA
441 357840 PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
442 358200 PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
443 ENDDO
444
445
2/2
✓ Branch 0 taken 14040 times.
✓ Branch 1 taken 360 times.
 14400 DO JK = 1 , KLEV
446 14040 IKL = KLEV+1 - JK
447 14040 IKLP1 = IKL + 1
448
2/2
✓ Branch 0 taken 13955760 times.
✓ Branch 1 taken 14040 times.
 13970160 DO JL = KIDIA,KFDIA
449 13955760 ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL, 1,IKL)
450 13955760 PRJ(JL,JAJ,IKL) = ZRE11
451 13969800 PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL, 1,IKL)
452 ENDDO
453 ENDDO
454
455 ELSE
456
457
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 720 times.
 1080 DO JAJ = 1 , 2
458
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716400 DO JL = KIDIA,KFDIA
459 715680 PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
460 716400 PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
461 ENDDO
462
463
2/2
✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
 29160 DO JK = 1 , KLEV
464 28080 IKL = KLEV+1 - JK
465 28080 IKLP1 = IKL + 1
466
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
 27940320 DO JL = KIDIA,KFDIA
467 27911520 ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,JAJ,IKL)
468 27911520 PRJ(JL,JAJ,IKL) = ZRE11
469 27939600 PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,JAJ,IKL)
470 ENDDO
471 ENDDO
472 ENDDO
473
474 ENDIF
475 IF(LLDEBUG) THEN
476 call writefield_phy ('swr_zc1i',ZC1I,KLEV+1)
477 call writefield_phy ('swr_zss1',ZSS1,1)
478 call writefield_phy ('swr_zclear',ZCLEAR,1)
479 call writefield_phy ('swr_prmue',PRMUE,KLEV+1)
480 call writefield_phy ('swr_psec',PSEC,1)
481 call writefield_phy ('swr_prmue',PRMUE,KLEV+1)
482 call writefield_phy ('swr_ppizaz',PPIZAZ,KLEV)
483 call writefield_phy ('swr_pcgaz',PCGAZ,KLEV)
484 call writefield_phy ('swr_pcg',PCG,KLEV)
485 call writefield_phy ('swr_ptau',PTAU(:,1,:),KLEV)
486 call writefield_phy ('swr_ptauaz',PTAUAZ,KLEV)
487 call writefield_phy ('swr_pcld',PCLD,KLEV)
488 ENDIF
489 ! ------------------------------------------------------------------
490
491
1/2
✓ Branch 0 taken 720 times.
✗ Branch 1 not taken.
 720 IF (LHOOK) CALL DR_HOOK('SWR',1,ZHOOK_HANDLE)
492 720 END SUBROUTINE SWR
493