GCC Code Coverage Report

Directory: ./
File: rad/rrtm_rtrn1a_140gp.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 268 284 94.4%
Branches: 119 142 83.8%
Line Branch Exec Source
1 119280 SUBROUTINE RRTM_RTRN1A_140GP (KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,&
2 & P_OD,P_TAUSF1,P_CLFNET,P_CLHTR,P_FNET,P_HTR,P_TOTDFLUC,P_TOTDFLUX,P_TOTUFLUC,P_TOTUFLUX,&
3 & P_TAVEL,PZ,P_TZ,P_TBOUND,PFRAC,P_SEMISS,P_SEMISLW,K_IREFLECT)
4
5 ! Reformatted for F90 by JJMorcrette, ECMWF, 980714
6 ! Speed-up by D.Salmond, ECMWF, 9907
7 ! Bug-fix by M.J. Iacono, AER, Inc., 9911
8 ! Bug-fix by JJMorcrette, ECMWF, 991209 (RAT1, RAT2 initialization)
9 ! Speed-up by D. Salmond, ECMWF, 9912
10 ! Bug-fix by JJMorcrette, ECMWF, 0005 (extrapolation T<160K)
11 ! Speed-up by D. Salmond, ECMWF, 000515
12
13 !-* This program calculates the upward fluxes, downward fluxes,
14 ! and heating rates for an arbitrary atmosphere. The input to
15 ! this program is the atmospheric profile and all Planck function
16 ! information. First-order "numerical" quadrature is used for the
17 ! angle integration, i.e. only one exponential is computed per layer
18 ! per g-value per band. Cloud overlap is treated with a generalized
19 ! maximum/random method in which adjacent cloud layers are treated
20 ! with maximum overlap, and non-adjacent cloud groups are treated
21 ! with random overlap. For adjacent cloud layers, cloud information
22 ! is carried from the previous two layers.
23
24 USE PARKIND1 ,ONLY : JPIM ,JPRB
25 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
26
27 USE PARRRTM , ONLY : JPBAND ,JPGPT ,JPLAY
28 USE YOERRTAB , ONLY : BPADE
29 USE YOERRTWN , ONLY : TOTPLNK ,DELWAVE
30 USE YOERRTFTR, ONLY : NGB
31
32 IMPLICIT NONE
33
34 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
35 INTEGER(KIND=JPIM),INTENT(IN) :: K_ISTART
36 INTEGER(KIND=JPIM),INTENT(IN) :: K_IEND
37 INTEGER(KIND=JPIM),INTENT(IN) :: K_ICLDLYR(JPLAY) ! Cloud indicator
38 REAL(KIND=JPRB) ,INTENT(IN) :: P_CLDFRAC(JPLAY) ! Cloud fraction
39 REAL(KIND=JPRB) :: Z_CLDFRAC(JPLAY) ! Cloud fraction
40 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
41 REAL(KIND=JPRB) ,INTENT(IN) :: P_ABSS1(JPGPT*JPLAY)
42 REAL(KIND=JPRB) ,INTENT(IN) :: P_OD(JPGPT,JPLAY)
43 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUSF1(JPGPT*JPLAY)
44 REAL(KIND=JPRB) :: P_CLFNET(0:JPLAY) ! Argument NOT used
45 REAL(KIND=JPRB) :: P_CLHTR(0:JPLAY) ! Argument NOT used
46 REAL(KIND=JPRB) :: P_FNET(0:JPLAY) ! Argument NOT used
47 REAL(KIND=JPRB) :: P_HTR(0:JPLAY) ! Argument NOT used
48 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUC(0:JPLAY)
49 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUX(0:JPLAY)
50 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUC(0:JPLAY)
51 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUX(0:JPLAY)
52 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(JPLAY)
53 REAL(KIND=JPRB) :: PZ(0:JPLAY) ! Argument NOT used
54 REAL(KIND=JPRB) ,INTENT(IN) :: P_TZ(0:JPLAY)
55 REAL(KIND=JPRB) ,INTENT(IN) :: P_TBOUND
56 REAL(KIND=JPRB) ,INTENT(IN) :: PFRAC(JPGPT,JPLAY)
57 REAL(KIND=JPRB) ,INTENT(IN) :: P_SEMISS(JPBAND)
58 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISLW
59 INTEGER(KIND=JPIM) :: K_IREFLECT ! Argument NOT used
60 !- from PROFILE
61 !- from SP
62 !- from SURFACE
63 INTEGER(KIND=JPIM) :: INDLAY(JPLAY),INDLEV(0:JPLAY)
64
65 REAL(KIND=JPRB) :: Z_BBU1(JPGPT*JPLAY),Z_BBUTOT1(JPGPT*JPLAY)
66 REAL(KIND=JPRB) :: Z_TLAYFRAC(JPLAY),Z_TLEVFRAC(0:JPLAY)
67 REAL(KIND=JPRB) :: Z_BGLEV(JPGPT)
68 !-- DS_000515
69 REAL(KIND=JPRB) :: Z_PLVL(JPBAND+1,0:JPLAY),Z_PLAY(JPBAND+1,0:JPLAY),Z_WTNUM(3)
70 !-- DS_000515
71 REAL(KIND=JPRB) :: Z_ODCLDNW(JPGPT,JPLAY)
72 REAL(KIND=JPRB) :: Z_SEMIS(JPGPT),Z_RADUEMIT(JPGPT)
73
74 REAL(KIND=JPRB) :: Z_RADCLRU1(JPGPT) ,Z_RADCLRD1(JPGPT)
75 REAL(KIND=JPRB) :: Z_RADLU1(JPGPT) ,Z_RADLD1(JPGPT)
76 !-- DS_000515
77 REAL(KIND=JPRB) :: Z_TRNCLD(JPLAY,JPBAND+1)
78 !-- DS_000515
79 REAL(KIND=JPRB) :: Z_ABSCLDNW(JPGPT,JPLAY)
80 REAL(KIND=JPRB) :: Z_ATOT1(JPGPT*JPLAY)
81
82 REAL(KIND=JPRB) :: Z_SURFEMIS(JPBAND),Z_PLNKEMIT(JPBAND)
83
84 ! dimension of arrays required for cloud overlap calculations
85
86 REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt)
87 REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt),Z_FACCLD1(jplay+1),Z_FACCLD2(jplay+1)
88 REAL(KIND=JPRB) :: Z_FACCLR1(jplay+1),Z_FACCLR2(jplay+1)
89 REAL(KIND=JPRB) :: Z_FACCMB1(jplay+1),Z_FACCMB2(jplay+1)
90 REAL(KIND=JPRB) :: Z_FACCLD1D(0:jplay),Z_FACCLD2D(0:jplay),Z_FACCLR1D(0:jplay)
91 REAL(KIND=JPRB) :: Z_FACCLR2D(0:jplay),Z_FACCMB1D(0:jplay),Z_FACCMB2D(0:jplay)
92 REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt)
93 INTEGER(KIND=JPIM) :: istcld(jplay+1),istcldd(0:jplay)
94 !******
95
96 !REAL_B :: ZPLVL(JPGPT+1,JPLAY) ,ZPLAY(JPGPT+1,JPLAY)
97 !REAL_B :: ZTRNCLD(JPGPT+1,JPLAY),ZTAUCLD(JPGPT+1,JPLAY)
98
99 INTEGER(KIND=JPIM) :: IBAND, ICLDDN, IENT, INDBOUND, INDEX, IPR, I_LAY, I_LEV, I_NBI
100
101 REAL(KIND=JPRB) :: Z_BBD, Z_BBDTOT, Z_BGLAY, Z_CLDSRC, Z_DBDTLAY, Z_DBDTLEV,&
102 & Z_DELBGDN, Z_DELBGUP, Z_DRAD1, Z_DRADCL1, Z_FACTOT1, &
103 & Z_FMAX, Z_FMIN, Z_GASSRC, Z_ODSM, Z_PLANKBND, Z_RADCLD, Z_RADD, Z_RADMOD, Z_RAT1, Z_RAT2, Z_SUMPL, &
104 & Z_SUMPLEM, Z_TBNDFRAC, Z_TRNS, Z_TTOT, Z_URAD1, Z_URADCL1, ZEXTAU
105 REAL(KIND=JPRB) :: ZHOOK_HANDLE
106
107
108
109 REAL(KIND=JPRB) :: CLFNET(0:JPLAY) ! Argument NOT used
110 REAL(KIND=JPRB) :: CLHTR(0:JPLAY) ! Argument NOT used
111 REAL(KIND=JPRB) :: FNET(0:JPLAY) ! Argument NOT used
112 REAL(KIND=JPRB) :: HTR(0:JPLAY) ! Argument NOT used
113
114
115
116 !--------------------------------------------------------------------------
117 ! Input
118 ! JPLAY ! Maximum number of model layers
119 ! JPGPT ! Total number of g-point subintervals
120 ! JPBAND ! Number of longwave spectral bands
121 ! SECANG ! Diffusivity angle
122 ! WTNUM ! Weight for radiance to flux conversion
123 ! KLEV ! Number of model layers
124 ! PAVEL(JPLAY) ! Mid-layer pressures (hPa)
125 ! PZ(0:JPLAY) ! Interface pressures (hPa)
126 ! TAVEL(JPLAY) ! Mid-layer temperatures (K)
127 ! TZ(0:JPLAY) ! Interface temperatures (K)
128 ! TBOUND ! Surface temperature
129 ! CLDFRAC(JPLAY) ! Layer cloud fraction
130 ! TAUCLD(JPLAY,JPBAND) ! Layer cloud optical thickness
131 ! ITR
132 ! PFRAC(JPGPT,JPLAY) ! Planck function fractions
133 ! ICLDLYR(JPLAY) ! Flag for cloudy layers
134 ! ICLD ! Flag for cloudy column
135 ! IREFLECT ! Flag for specular reflection
136 ! SEMISS(JPBAND) ! Surface spectral emissivity
137 ! BPADE ! Pade constant
138 ! OD ! Clear-sky optical thickness
139 ! TAUSF1 !
140 ! ABSS1 !
141
142 ! ABSS(JPGPT*JPLAY) !
143 ! ABSCLD(JPLAY) !
144 ! ATOT(JPGPT*JPLAY) !
145 ! ODCLR(JPGPT,JPLAY) !
146 ! ODCLD(JPBAND,JPLAY) !
147 ! EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction
148 ! RADLU(JPGPT) ! Upward radiance
149 ! URAD ! Spectrally summed upward radiance
150 ! RADCLRU(JPGPT) ! Clear-sky upward radiance
151 ! CLRURAD ! Spectrally summed clear-sky upward radiance
152 ! RADLD(JPGPT) ! Downward radiance
153 ! DRAD ! Spectrally summed downward radiance
154 ! RADCLRD(JPGPT) ! Clear-sky downward radiance
155 ! CLRDRAD ! Spectrally summed clear-sky downward radiance
156
157 ! Output
158 ! TOTUFLUX(0:JPLAY) ! Upward longwave flux
159 ! TOTDFLUX(0:JPLAY) ! Downward longwave flux
160 ! TOTUFLUC(0:JPLAY) ! Clear-sky upward longwave flux
161 ! TOTDFLUC(0:JPLAY) ! Clear-sky downward longwave flux
162
163 ! Maximum/Random cloud overlap variables
164 ! for upward radiaitve transfer
165 ! FACCLR2 fraction of clear radiance from previous layer that needs to
166 ! be switched to cloudy stream
167 ! FACCLR1 fraction of the radiance that had been switched in the previous
168 ! layer from cloudy to clear that needs to be switched back to
169 ! cloudy in the current layer
170 ! FACCLD2 fraction of cloudy radiance from previous layer that needs to
171 ! be switched to clear stream
172 ! be switched to cloudy stream
173 ! FACCLD1 fraction of the radiance that had been switched in the previous
174 ! layer from clear to cloudy that needs to be switched back to
175 ! clear in the current layer
176 ! for downward radiaitve transfer
177 ! FACCLR2D fraction of clear radiance from previous layer that needs to
178 ! be switched to cloudy stream
179 ! FACCLR1D fraction of the radiance that had been switched in the previous
180 ! layer from cloudy to clear that needs to be switched back to
181 ! cloudy in the current layer
182 ! FACCLD2D fraction of cloudy radiance from previous layer that needs to
183 ! be switched to clear stream
184 ! be switched to cloudy stream
185 ! FACCLD1D fraction of the radiance that had been switched in the previous
186 ! layer from clear to cloudy that needs to be switched back to
187 ! clear in the current layer
188
189 !--------------------------------------------------------------------------
190
191 ! CORRECTION PROVISOIRE BUG POTENTIEL MPLFH
192 ! on initialise le niveau klev+1 de p_cldfrac, tableau surdimensionne
193 ! a 100 mais apparemment non initialise en klev+1
194
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 Z_CLDFRAC(1:KLEV)=P_CLDFRAC(1:KLEV)
195 119280 Z_CLDFRAC(KLEV+1)=0.0_JPRB
196
1/2
✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
 119280 IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',0,ZHOOK_HANDLE)
197 Z_WTNUM(1)=0.5_JPRB
198 Z_WTNUM(2)=0.0_JPRB
199 Z_WTNUM(3)=0.0_JPRB
200
201 DO I_LAY = 0, KLEV
202 ENDDO
203 !-start JJM_000511
204
2/4
✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 119280 times.
✗ Branch 3 not taken.
 119280 IF (P_TBOUND < 339._JPRB .AND. P_TBOUND >= 160._JPRB ) THEN
205 119280 INDBOUND = P_TBOUND - 159._JPRB
206 119280 Z_TBNDFRAC = P_TBOUND - INT(P_TBOUND)
207 ✗ ELSEIF (P_TBOUND >= 339._JPRB ) THEN
208 INDBOUND = 180
209 ✗ Z_TBNDFRAC = P_TBOUND - 339._JPRB
210 ✗ ELSEIF (P_TBOUND < 160._JPRB ) THEN
211 INDBOUND = 1
212 ✗ Z_TBNDFRAC = P_TBOUND - 160._JPRB
213 ENDIF
214 !-end JJM_000511
215
216
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 119280 times.
 4890480 DO I_LAY = 0, KLEV
217 4771200 P_TOTUFLUC(I_LAY) = 0.0_JPRB
218 4771200 P_TOTDFLUC(I_LAY) = 0.0_JPRB
219 4771200 P_TOTUFLUX(I_LAY) = 0.0_JPRB
220 4771200 P_TOTDFLUX(I_LAY) = 0.0_JPRB
221 !-start JJM_000511
222
2/4
✓ Branch 0 taken 4771200 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 4771200 times.
✗ Branch 3 not taken.
 4890480 IF (P_TZ(I_LAY) < 339._JPRB .AND. P_TZ(I_LAY) >= 160._JPRB ) THEN
223 4771200 INDLEV(I_LAY) = P_TZ(I_LAY) - 159._JPRB
224 4771200 Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - INT(P_TZ(I_LAY))
225 ✗ ELSEIF (P_TZ(I_LAY) >= 339._JPRB ) THEN
226 ✗ INDLEV(I_LAY) = 180
227 ✗ Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 339._JPRB
228 ✗ ELSEIF (P_TZ(I_LAY) < 160._JPRB ) THEN
229 ✗ INDLEV(I_LAY) = 1
230 ✗ Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 160._JPRB
231 ENDIF
232 !-end JJM_000511
233 ENDDO
234
235 !_start_jjm 991209
236
2/2
✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 119280 times.
 4890480 DO I_LEV=0,KLEV
237 4771200 Z_FACCLD1(I_LEV+1) = 0.0_JPRB
238 4771200 Z_FACCLD2(I_LEV+1) = 0.0_JPRB
239 4771200 Z_FACCLR1(I_LEV+1) = 0.0_JPRB
240 4771200 Z_FACCLR2(I_LEV+1) = 0.0_JPRB
241 4771200 Z_FACCMB1(I_LEV+1) = 0.0_JPRB
242 4771200 Z_FACCMB2(I_LEV+1) = 0.0_JPRB
243 4771200 Z_FACCLD1D(I_LEV) = 0.0_JPRB
244 4771200 Z_FACCLD2D(I_LEV) = 0.0_JPRB
245 4771200 Z_FACCLR1D(I_LEV) = 0.0_JPRB
246 4771200 Z_FACCLR2D(I_LEV) = 0.0_JPRB
247 4771200 Z_FACCMB1D(I_LEV) = 0.0_JPRB
248 4890480 Z_FACCMB2D(I_LEV) = 0.0_JPRB
249 ENDDO
250
251 Z_RAT1 = 0.0_JPRB
252 Z_RAT2 = 0.0_JPRB
253
254 !_end_jjm 991209
255
256 Z_SUMPL = 0.0_JPRB
257 Z_SUMPLEM = 0.0_JPRB
258
259 119280 ISTCLD(1) = 1
260 119280 ISTCLDD(KLEV) = 1
261
262
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = 1, KLEV
263 !-- DS_000515
264 !-start JJM_000511
265
2/4
✓ Branch 0 taken 4651920 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 4651920 times.
✗ Branch 3 not taken.
 4771200 IF (P_TAVEL(I_LEV) < 339._JPRB .AND. P_TAVEL(I_LEV) >= 160._JPRB ) THEN
266 4651920 INDLAY(I_LEV) = P_TAVEL(I_LEV) - 159._JPRB
267 4651920 Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - INT(P_TAVEL(I_LEV))
268 ✗ ELSEIF (P_TAVEL(I_LEV) >= 339._JPRB ) THEN
269 ✗ INDLAY(I_LEV) = 180
270 ✗ Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 339._JPRB
271 ✗ ELSEIF (P_TAVEL(I_LEV) < 160._JPRB ) THEN
272 ✗ INDLAY(I_LEV) = 1
273 ✗ Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 160._JPRB
274 ENDIF
275 !-end JJM_000511
276 ENDDO
277 !-- DS_000515
278
279 !-- DS_000515
280 !OCL SCALAR
281
282
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = 1, KLEV
283
2/2
✓ Branch 0 taken 1092037 times.
✓ Branch 1 taken 3559883 times.
 4771200 IF (K_ICLDLYR(I_LEV) == 1) THEN
284
285 !mji
286 1092037 ISTCLD(I_LEV+1) = 0
287
2/2
✓ Branch 0 taken 1294 times.
✓ Branch 1 taken 1090743 times.
 1092037 IF (I_LEV == KLEV) THEN
288 1294 Z_FACCLD1(I_LEV+1) = 0.0_JPRB
289 1294 Z_FACCLD2(I_LEV+1) = 0.0_JPRB
290 1294 Z_FACCLR1(I_LEV+1) = 0.0_JPRB
291 1294 Z_FACCLR2(I_LEV+1) = 0.0_JPRB
292 !-- DS_000515
293 !SB debug >>
294 1294 Z_FACCMB1(I_LEV+1) =0.0_JPRB
295 1294 Z_FACCMB2(I_LEV+1) =0.0_JPRB
296 !SB debug <<
297 !mji ISTCLD(LEV+1) = _ZERO_
298
2/2
✓ Branch 0 taken 418837 times.
✓ Branch 1 taken 671906 times.
 1090743 ELSEIF (Z_CLDFRAC(I_LEV+1) >= Z_CLDFRAC(I_LEV)) THEN
299 418837 Z_FACCLD1(I_LEV+1) = 0.0_JPRB
300 418837 Z_FACCLD2(I_LEV+1) = 0.0_JPRB
301
2/2
✓ Branch 0 taken 113223 times.
✓ Branch 1 taken 305614 times.
 418837 IF (ISTCLD(I_LEV) == 1) THEN
302 !mji ISTCLD(LEV+1) = 0
303 113223 Z_FACCLR1(I_LEV+1) = 0.0_JPRB
304 !mji
305 113223 Z_FACCLR2(I_LEV+1) = 0.0_JPRB
306
2/2
✓ Branch 0 taken 113190 times.
✓ Branch 1 taken 33 times.
 113223 IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN
307 Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/&
308 113190 & (1.0_JPRB-Z_CLDFRAC(I_LEV))
309 ENDIF
310 !SB debug >>
311 113223 Z_FACCLR2(I_LEV) = 0.0_JPRB
312 113223 Z_FACCLD2(I_LEV) = 0.0_JPRB
313 !SB debug <<
314 ELSE
315 305614 Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1))
316 !mji
317
2/2
✓ Branch 0 taken 215591 times.
✓ Branch 1 taken 90023 times.
 305614 IF (Z_CLDFRAC(I_LEV+1) > Z_FMAX) THEN
318 215591 Z_FACCLR1(I_LEV+1) = Z_RAT2
319 215591 Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
320 !mji
321
2/2
✓ Branch 0 taken 31973 times.
✓ Branch 1 taken 58050 times.
 90023 ELSEIF (Z_CLDFRAC(I_LEV+1) < Z_FMAX) THEN
322 Z_FACCLR1(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/&
323 31973 & (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))
324 31973 Z_FACCLR2(I_LEV+1) = 0.0_JPRB
325 !mji
326 ELSE
327 58050 Z_FACCLR1(I_LEV+1) = Z_RAT2
328 58050 Z_FACCLR2(I_LEV+1) = 0.0_JPRB
329 ENDIF
330 ENDIF
331
4/4
✓ Branch 0 taken 357880 times.
✓ Branch 1 taken 60957 times.
✓ Branch 2 taken 59576 times.
✓ Branch 3 taken 298304 times.
 418837 IF (Z_FACCLR1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLR2(I_LEV+1) > 0.0_JPRB) THEN
332 Z_RAT1 = 1.0_JPRB
333 Z_RAT2 = 0.0_JPRB
334 !SB debug >>
335 ! ENDIF
336 ELSE
337 Z_RAT1 = 0.0_JPRB
338 Z_RAT2 = 0.0_JPRB
339 ENDIF
340 !SB debug <<
341 ELSE
342 671906 Z_FACCLR1(I_LEV+1) = 0.0_JPRB
343 671906 Z_FACCLR2(I_LEV+1) = 0.0_JPRB
344
2/2
✓ Branch 0 taken 77494 times.
✓ Branch 1 taken 594412 times.
 671906 IF (ISTCLD(I_LEV) == 1) THEN
345 !mji ISTCLD(LEV+1) = 0
346 77494 Z_FACCLD1(I_LEV+1) = 0.0_JPRB
347 77494 Z_FACCLD2(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/Z_CLDFRAC(I_LEV)
348 !SB debug >>
349 77494 Z_FACCLR2(I_LEV) = 0.0_JPRB
350 77494 Z_FACCLD2(I_LEV) = 0.0_JPRB
351 !SB debug <<
352 ELSE
353 594412 Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1))
354
2/2
✓ Branch 0 taken 533019 times.
✓ Branch 1 taken 61393 times.
 594412 IF (Z_CLDFRAC(I_LEV+1) <= Z_FMIN) THEN
355 533019 Z_FACCLD1(I_LEV+1) = Z_RAT1
356 533019 Z_FACCLD2(I_LEV+1) = (Z_FMIN-Z_CLDFRAC(I_LEV+1))/Z_FMIN
357 ELSE
358 Z_FACCLD1(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/&
359 61393 & (Z_CLDFRAC(I_LEV)-Z_FMIN)
360 61393 Z_FACCLD2(I_LEV+1) = 0.0_JPRB
361 ENDIF
362 ENDIF
363
3/4
✓ Branch 0 taken 516425 times.
✓ Branch 1 taken 155481 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 516425 times.
 671906 IF (Z_FACCLD1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLD2(I_LEV+1) > 0.0_JPRB) THEN
364 Z_RAT1 = 0.0_JPRB
365 Z_RAT2 = 1.0_JPRB
366 !SB debug >>
367 ! ENDIF
368 ELSE
369 Z_RAT1 = 0.0_JPRB
370 Z_RAT2 = 0.0_JPRB
371 ENDIF
372 !SB debug <<
373 ENDIF
374 !fcc
375
376 !SB debug >>
377 ! IF (I_LEV == 1) THEN
378 ! Z_FACCMB1(I_LEV+1) = 0.
379 ! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV)
380 ! ELSE
381 ! Z_FACCMB1(I_LEV+1) = Z_FACCLR1(I_LEV+1) * Z_FACCLD2(I_LEV) *Z_CLDFRAC(I_LEV-1)
382 ! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) *&
383 ! & (1.0_JPRB - Z_CLDFRAC(I_LEV-1))
384 ! ENDIF
385
3/4
✓ Branch 0 taken 900026 times.
✓ Branch 1 taken 192011 times.
✓ Branch 2 taken 900026 times.
✗ Branch 3 not taken.
 1092037 if(istcld(i_lev).ne.1.and.i_lev.ne.1) then
386 z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
387 900026 z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
388 z_faccmb2(i_lev+1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), &
389 900026 z_cldfrac(i_lev)-z_cldfrac(i_lev-1)))
390 endif
391 !SB debug <<
392 !end fcc
393 ELSE
394 !-- DS_000515
395 3559883 ISTCLD(I_LEV+1) = 1
396 ENDIF
397 ENDDO
398
399 !_start_jjm 991209
400 Z_RAT1 = 0.0_JPRB
401 Z_RAT2 = 0.0_JPRB
402 !_end_jjm 991209
403
404 !-- DS_000515
405 !OCL SCALAR
406
407
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = KLEV, 1, -1
408
2/2
✓ Branch 0 taken 1092037 times.
✓ Branch 1 taken 3559883 times.
 4771200 IF (K_ICLDLYR(I_LEV) == 1) THEN
409 !mji
410 1092037 ISTCLDD(I_LEV-1) = 0
411
2/2
✓ Branch 0 taken 31976 times.
✓ Branch 1 taken 1060061 times.
 1092037 IF (I_LEV == 1) THEN
412 31976 Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
413 31976 Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
414 31976 Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
415 31976 Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
416 31976 Z_FACCMB1D(I_LEV-1) = 0.0_JPRB
417 31976 Z_FACCMB2D(I_LEV-1) = 0.0_JPRB
418 !mji ISTCLDD(LEV-1) = _ZERO_
419
2/2
✓ Branch 0 taken 540765 times.
✓ Branch 1 taken 519296 times.
 1060061 ELSEIF (Z_CLDFRAC(I_LEV-1) >= Z_CLDFRAC(I_LEV)) THEN
420 540765 Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
421 540765 Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
422
2/2
✓ Branch 0 taken 121156 times.
✓ Branch 1 taken 419609 times.
 540765 IF (ISTCLDD(I_LEV) == 1) THEN
423 !mji ISTCLDD(LEV-1) = 0
424 121156 Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
425 121156 Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
426
2/2
✓ Branch 0 taken 120815 times.
✓ Branch 1 taken 341 times.
 121156 IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN
427 Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/&
428 120815 & (1.0_JPRB-Z_CLDFRAC(I_LEV))
429 ENDIF
430 !SB debug >>
431 121156 z_facclr2d(i_lev)=0.0_JPRB
432 121156 z_faccld2d(i_lev)=0.0_JPRB
433 !SB debug <<
434 ELSE
435 419609 Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1))
436 !mji
437
2/2
✓ Branch 0 taken 334152 times.
✓ Branch 1 taken 85457 times.
 419609 IF (Z_CLDFRAC(I_LEV-1) > Z_FMAX) THEN
438 334152 Z_FACCLR1D(I_LEV-1) = Z_RAT2
439 334152 Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
440 !mji
441
2/2
✓ Branch 0 taken 26952 times.
✓ Branch 1 taken 58505 times.
 85457 ELSEIF (Z_CLDFRAC(I_LEV-1) < Z_FMAX) THEN
442 Z_FACCLR1D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/&
443 26952 & (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))
444 26952 Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
445 !mji
446 ELSE
447 58505 Z_FACCLR1D(I_LEV-1) = Z_RAT2
448 58505 Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
449 ENDIF
450 ENDIF
451
4/4
✓ Branch 0 taken 479808 times.
✓ Branch 1 taken 60957 times.
✓ Branch 2 taken 59576 times.
✓ Branch 3 taken 420232 times.
 540765 IF (Z_FACCLR1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLR2D(I_LEV-1) > 0.0_JPRB)THEN
452 Z_RAT1 = 1.0_JPRB
453 Z_RAT2 = 0.0_JPRB
454 !SB debug >>
455 ! ENDIF
456 else
457 Z_RAT1 = 0.0_JPRB
458 Z_RAT2 = 0.0_JPRB
459 endif
460 !SB debug <<
461 ELSE
462 519296 Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
463 519296 Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
464
2/2
✓ Branch 0 taken 63055 times.
✓ Branch 1 taken 456241 times.
 519296 IF (ISTCLDD(I_LEV) == 1) THEN
465 !mji ISTCLDD(LEV-1) = 0
466 63055 Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
467 63055 Z_FACCLD2D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/Z_CLDFRAC(I_LEV)
468 !SB debug >>
469 63055 z_facclr2d(i_lev)=0.0_JPRB
470 63055 z_faccld2d(i_lev)=0.0_JPRB
471 !SB debug <<
472 ELSE
473 456241 Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1))
474
2/2
✓ Branch 0 taken 394578 times.
✓ Branch 1 taken 61663 times.
 456241 IF (Z_CLDFRAC(I_LEV-1) <= Z_FMIN) THEN
475 394578 Z_FACCLD1D(I_LEV-1) = Z_RAT1
476 394578 Z_FACCLD2D(I_LEV-1) = (Z_FMIN-Z_CLDFRAC(I_LEV-1))/Z_FMIN
477 ELSE
478 Z_FACCLD1D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/&
479 61663 & (Z_CLDFRAC(I_LEV)-Z_FMIN)
480 61663 Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
481 ENDIF
482 ENDIF
483
3/4
✓ Branch 0 taken 365728 times.
✓ Branch 1 taken 153568 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 365728 times.
 519296 IF (Z_FACCLD1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLD2D(I_LEV-1) > 0.0_JPRB)THEN
484 Z_RAT1 = 0.0_JPRB
485 Z_RAT2 = 1.0_JPRB
486 !SB debug >>
487 ! ENDIF
488 ELSE
489 Z_RAT1 = 0.0_JPRB
490 Z_RAT2 = 0.0_JPRB
491 ENDIF
492 !SB debug <<
493 ENDIF
494 !SB debug >>
495 ! Z_FACCMB1D(I_LEV-1) = Z_FACCLR1D(I_LEV-1) * Z_FACCLD2D(I_LEV) *Z_CLDFRAC(I_LEV+1)
496 ! Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *&
497 ! & (1.0_JPRB - Z_CLDFRAC(I_LEV+1))
498
4/4
✓ Branch 0 taken 900026 times.
✓ Branch 1 taken 192011 times.
✓ Branch 2 taken 875850 times.
✓ Branch 3 taken 24176 times.
 1092037 if (istcldd(i_lev).ne.1.and.i_lev.ne.1) then
499 z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
500 875850 z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
501 z_faccmb2d(i_lev-1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), &
502 875850 z_cldfrac(i_lev)-z_cldfrac(i_lev-1)))
503 endif
504 !SB debug <<
505 ELSE
506 3559883 ISTCLDD(I_LEV-1) = 1
507 ENDIF
508 ENDDO
509
510 !- Loop over frequency bands.
511
512
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 1908480 times.
 2027760 DO IBAND = K_ISTART, K_IEND
513 1908480 Z_DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND)
514 1908480 Z_PLANKBND = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) + Z_TBNDFRAC * Z_DBDTLEV)
515 1908480 Z_DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -TOTPLNK(INDLEV(0),IBAND)
516 !-- DS_000515
517 Z_PLVL(IBAND,0) = DELWAVE(IBAND)&
518 1908480 & * (TOTPLNK(INDLEV(0),IBAND) + Z_TLEVFRAC(0)*Z_DBDTLEV)
519
520 1908480 Z_SURFEMIS(IBAND) = P_SEMISS(IBAND)
521 1908480 Z_PLNKEMIT(IBAND) = Z_SURFEMIS(IBAND) * Z_PLANKBND
522 1908480 Z_SUMPLEM = Z_SUMPLEM + Z_PLNKEMIT(IBAND)
523 2027760 Z_SUMPL = Z_SUMPL + Z_PLANKBND
524 !--DS
525 ENDDO
526 !---
527
528 !-- DS_000515
529
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = 1, KLEV
530
2/2
✓ Branch 0 taken 74430720 times.
✓ Branch 1 taken 4651920 times.
 79201920 DO IBAND = K_ISTART, K_IEND
531 ! print *,'RTRN1A: I_LEV JPLAY IBAND INDLAY',I_LEV,JPLAY,IBAND,INDLAY(I_LEV)
532 !----
533 !- Calculate the integrated Planck functions for at the
534 ! level and layer temperatures.
535 ! Compute cloud transmittance for cloudy layers.
536 74430720 Z_DBDTLEV = TOTPLNK(INDLEV(I_LEV)+1,IBAND) - TOTPLNK(INDLEV(I_LEV),IBAND)
537 74430720 Z_DBDTLAY = TOTPLNK(INDLAY(I_LEV)+1,IBAND) - TOTPLNK(INDLAY(I_LEV),IBAND)
538 !-- DS_000515
539 Z_PLAY(IBAND,I_LEV) = DELWAVE(IBAND)&
540 74430720 & *(TOTPLNK(INDLAY(I_LEV),IBAND)+Z_TLAYFRAC(I_LEV)*Z_DBDTLAY)
541 Z_PLVL(IBAND,I_LEV) = DELWAVE(IBAND)&
542 74430720 & *(TOTPLNK(INDLEV(I_LEV),IBAND)+Z_TLEVFRAC(I_LEV)*Z_DBDTLEV)
543
2/2
✓ Branch 0 taken 17472592 times.
✓ Branch 1 taken 56958128 times.
 79082640 IF (K_ICLDLYR(I_LEV) > 0) THEN
544 17472592 ZEXTAU = MIN( P_TAUCLD(I_LEV,IBAND), 200._JPRB)
545 17472592 Z_TRNCLD(I_LEV,IBAND) = EXP( -ZEXTAU )
546 ENDIF
547 !-- DS_000515
548 ENDDO
549
550 ENDDO
551
552 119280 P_SEMISLW = Z_SUMPLEM / Z_SUMPL
553
554 !--DS
555 !O IPR = 1, JPGPT
556 ! NBI = NGB(IPR)
557 ! DO LEV = 1 , KLEV
558 !-- DS_000515
559 ! ZPLAY(IPR,LEV) = PLAY(LEV,NGB(IPR))
560 ! ZPLVL(IPR,LEV) = PLVL(LEV-1,NGB(IPR))
561 ! ZTAUCLD(IPR,LEV) = TAUCLD(LEV,NGB(IPR))
562 ! ZTRNCLD(IPR,LEV) = TRNCLD(LEV,NGB(IPR))
563 !-- DS_000515
564 ! ENDDO
565 !NDDO
566 !----
567
568 !- For cloudy layers, set cloud parameters for radiative transfer.
569
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = 1, KLEV
570
2/2
✓ Branch 0 taken 1092037 times.
✓ Branch 1 taken 3559883 times.
 4771200 IF (K_ICLDLYR(I_LEV) > 0) THEN
571
2/2
✓ Branch 0 taken 152885180 times.
✓ Branch 1 taken 1092037 times.
 153977217 DO IPR = 1, JPGPT
572 !--DS
573 ! NBI = NGB(IPR)
574 152885180 Z_ODCLDNW(IPR,I_LEV) = P_TAUCLD(I_LEV,NGB(IPR))
575 153977217 Z_ABSCLDNW(IPR,I_LEV) = 1.0_JPRB - Z_TRNCLD(I_LEV,NGB(IPR))
576 !----
577 ! EFCLFRNW(IPR,LEV) = ABSCLDNW(IPR,LEV) * CLDFRAC(LEV)
578 ENDDO
579 ENDIF
580 ENDDO
581
582 !- Initialize for radiative transfer.
583
2/2
✓ Branch 0 taken 16699200 times.
✓ Branch 1 taken 119280 times.
 16818480 DO IPR = 1, JPGPT
584 16699200 Z_RADCLRD1(IPR) = 0.0_JPRB
585 16699200 Z_RADLD1(IPR) = 0.0_JPRB
586 16699200 I_NBI = NGB(IPR)
587 16699200 Z_SEMIS(IPR) = Z_SURFEMIS(I_NBI)
588 16699200 Z_RADUEMIT(IPR) = PFRAC(IPR,1) * Z_PLNKEMIT(I_NBI)
589 !-- DS_000515
590 16818480 Z_BGLEV(IPR) = PFRAC(IPR,KLEV) * Z_PLVL(I_NBI,KLEV)
591 ENDDO
592
593 !- Downward radiative transfer.
594 ! *** DRAD1 holds summed radiance for total sky stream
595 ! *** DRADCL1 holds summed radiance for clear sky stream
596
597 ICLDDN = 0
598
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = KLEV, 1, -1
599 Z_DRAD1 = 0.0_JPRB
600 Z_DRADCL1 = 0.0_JPRB
601
602
2/2
✓ Branch 0 taken 1092037 times.
✓ Branch 1 taken 3559883 times.
 4651920 IF (K_ICLDLYR(I_LEV) == 1) THEN
603
604 ! *** Cloudy layer
605 ICLDDN = 1
606 1092037 IENT = JPGPT * (I_LEV-1)
607
2/2
✓ Branch 0 taken 152885180 times.
✓ Branch 1 taken 1092037 times.
 153977217 DO IPR = 1, JPGPT
608 152885180 INDEX = IENT + IPR
609 !--DS
610 ! NBI = NGB(IPR)
611 152885180 Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
612 !----
613 152885180 Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY
614 152885180 Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
615 !--DS
616 152885180 Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
617 !----
618 152885180 Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
619 152885180 Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
620 !- total-sky downward flux
621 152885180 Z_ODSM = P_OD(IPR,I_LEV) + Z_ODCLDNW(IPR,I_LEV)
622 152885180 Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM)
623 152885180 Z_BBUTOT1(INDEX) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP
624 Z_ATOT1(INDEX) = P_ABSS1(INDEX) + Z_ABSCLDNW(IPR,I_LEV)&
625 152885180 & - P_ABSS1(INDEX) * Z_ABSCLDNW(IPR,I_LEV)
626 152885180 Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN
627 152885180 Z_GASSRC = Z_BBD * P_ABSS1(INDEX)
628 !***
629
2/2
✓ Branch 0 taken 26881540 times.
✓ Branch 1 taken 126003640 times.
 152885180 IF (ISTCLDD(I_LEV) == 1) THEN
630 26881540 Z_CLDRADD(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLD1(IPR)
631 26881540 Z_CLRRADD(IPR) = Z_RADLD1(IPR) - Z_CLDRADD(IPR)
632 Z_OLDCLD(IPR) = Z_CLDRADD(IPR)
633 Z_OLDCLR(IPR) = Z_CLRRADD(IPR)
634 26881540 Z_RAD(IPR) = 0.0_JPRB
635 ENDIF
636 152885180 Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX)
637 152885180 Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX)
638
639 ! Separate RT equations for clear and cloudy streams
640 152885180 Z_CLDRADD(IPR) = Z_CLDRADD(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC
641 Z_CLRRADD(IPR) = Z_CLRRADD(IPR) * (1.0_JPRB-P_ABSS1(INDEX)) +&
642 152885180 & (1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC
643
644 ! Total sky downward radiance
645 152885180 Z_RADLD1(IPR) = Z_CLDRADD(IPR) + Z_CLRRADD(IPR)
646 152885180 Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
647
648 ! Clear-sky downward radiance
649 152885180 Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX)
650 152885180 Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR)
651
652 !* Code to account for maximum/random overlap:
653 ! Performs RT on the radiance most recently switched between clear and
654 ! cloudy streams
655 Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1D(I_LEV-1) * (1.0_JPRB-P_ABSS1(INDEX)) +&
656 & Z_FACCLD1D(I_LEV-1) * Z_TTOT) - &
657 & Z_FACCMB1D(I_LEV-1) * Z_GASSRC + &
658 152885180 & Z_FACCMB2D(I_LEV-1) * Z_CLDSRC
659
660 ! Computes what the clear and cloudy streams would have been had no
661 ! radiance been switched
662 152885180 Z_OLDCLD(IPR) = Z_CLDRADD(IPR) - Z_RADMOD
663 152885180 Z_OLDCLR(IPR) = Z_CLRRADD(IPR) + Z_RADMOD
664
665 ! Computes the radiance to be switched between clear and cloudy.
666 Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2D(I_LEV-1)*Z_OLDCLR(IPR) -&
667 152885180 & Z_FACCLD2D(I_LEV-1)*Z_OLDCLD(IPR)
668 152885180 Z_CLDRADD(IPR) = Z_CLDRADD(IPR) + Z_RAD(IPR)
669 153977217 Z_CLRRADD(IPR) = Z_CLRRADD(IPR) - Z_RAD(IPR)
670 !***
671
672 ENDDO
673
674 ELSE
675
676 ! *** Clear layer
677 ! *** DRAD1 holds summed radiance for total sky stream
678 ! *** DRADCL1 holds summed radiance for clear sky stream
679
680 3559883 IENT = JPGPT * (I_LEV-1)
681
2/2
✓ Branch 0 taken 885628 times.
✓ Branch 1 taken 2674255 times.
 3559883 IF (ICLDDN == 1) THEN
682
2/2
✓ Branch 0 taken 885628 times.
✓ Branch 1 taken 123987920 times.
 124873548 DO IPR = 1, JPGPT
683 123987920 INDEX = IENT + IPR
684 !--DS
685 ! NBI = NGB(IPR)
686 123987920 Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
687 !----
688 123987920 Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY
689 123987920 Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
690 !--DS
691 123987920 Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
692 !----
693 123987920 Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
694 123987920 Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
695
696 !- total-sky downward radiance
697 123987920 Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX)
698 123987920 Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
699
700 !- clear-sky downward radiance
701 !- Set clear sky stream to total sky stream as long as layers
702 !- remain clear. Streams diverge when a cloud is reached.
703 123987920 Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX)
704 124873548 Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR)
705 ENDDO
706
707 ELSE
708
709
2/2
✓ Branch 0 taken 2674255 times.
✓ Branch 1 taken 374395700 times.
 377069955 DO IPR = 1, JPGPT
710 374395700 INDEX = IENT + IPR
711 !--DS
712 ! NBI = NGB(IPR)
713 374395700 Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
714 !----
715 374395700 Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY
716 374395700 Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
717 !--DS
718 374395700 Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
719 !----
720 374395700 Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
721 374395700 Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
722 !- total-sky downward flux
723 374395700 Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX)
724 374395700 Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
725 !- clear-sky downward flux
726 !- Set clear sky stream to total sky stream as long as layers
727 !- remain clear. Streams diverge when a cloud is reached.
728 377069955 Z_RADCLRD1(IPR) = Z_RADLD1(IPR)
729 ENDDO
730 Z_DRADCL1 = Z_DRAD1
731 ENDIF
732
733 ENDIF
734
735 4651920 P_TOTDFLUC(I_LEV-1) = Z_DRADCL1 * Z_WTNUM(1)
736 4771200 P_TOTDFLUX(I_LEV-1) = Z_DRAD1 * Z_WTNUM(1)
737
738 ENDDO
739
740 ! Spectral reflectivity and reflectance
741 ! Includes the contribution of spectrally varying longwave emissivity
742 ! and reflection from the surface to the upward radiative transfer.
743 ! Note: Spectral and Lambertian reflections are identical for the one
744 ! angle flux integration used here.
745
746 Z_URAD1 = 0.0_JPRB
747 Z_URADCL1 = 0.0_JPRB
748
749 !start JJM_000511
750 !IF (IREFLECT == 0) THEN
751 !- Lambertian reflection.
752
2/2
✓ Branch 0 taken 16699200 times.
✓ Branch 1 taken 119280 times.
 16818480 DO IPR = 1, JPGPT
753 ! Clear-sky radiance
754 ! RADCLD = _TWO_ * (RADCLRD1(IPR) * WTNUM(1) )
755 16699200 Z_RADCLD = Z_RADCLRD1(IPR)
756 16699200 Z_RADCLRU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADCLD
757 16699200 Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
758
759 ! Total sky radiance
760 ! RADD = _TWO_ * (RADLD1(IPR) * WTNUM(1) )
761 16699200 Z_RADD = Z_RADLD1(IPR)
762 16699200 Z_RADLU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADD
763 16818480 Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
764 ENDDO
765 119280 P_TOTUFLUC(0) = Z_URADCL1 * 0.5_JPRB
766 119280 P_TOTUFLUX(0) = Z_URAD1 * 0.5_JPRB
767 !ELSE
768 !!- Specular reflection.
769 ! DO IPR = 1, JPGPT
770 ! RADCLU = RADUEMIT(IPR)
771 ! RADCLRU1(IPR) = RADCLU + (_ONE_ - SEMIS(IPR)) * RADCLRD1(IPR)
772 ! URADCL1 = URADCL1 + RADCLRU1(IPR)
773
774 ! RADU = RADUEMIT(IPR)
775 ! RADLU1(IPR) = RADU + (_ONE_ - SEMIS(IPR)) * RADLD1(IPR)
776 ! URAD1 = URAD1 + RADLU1(IPR)
777 ! ENDDO
778 ! TOTUFLUC(0) = URADCL1 * WTNUM(1)
779 ! TOTUFLUX(0) = URAD1 * WTNUM(1)
780 !ENDIF
781
782 !- Upward radiative transfer.
783 !- *** URAD1 holds the summed radiance for total sky stream
784 !- *** URADCL1 holds the summed radiance for clear sky stream
785
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_LEV = 1, KLEV
786 Z_URAD1 = 0.0_JPRB
787 Z_URADCL1 = 0.0_JPRB
788
789 ! Check flag for cloud in current layer
790
2/2
✓ Branch 0 taken 1092037 times.
✓ Branch 1 taken 3559883 times.
 4651920 IF (K_ICLDLYR(I_LEV) == 1) THEN
791
792 !- *** Cloudy layer
793 1092037 IENT = JPGPT * (I_LEV-1)
794
2/2
✓ Branch 0 taken 152885180 times.
✓ Branch 1 taken 1092037 times.
 153977217 DO IPR = 1, JPGPT
795 152885180 INDEX = IENT + IPR
796 !- total-sky upward flux
797 152885180 Z_GASSRC = Z_BBU1(INDEX) * P_ABSS1(INDEX)
798
799 !- If first cloudy layer in sequence, split up radiance into clear and
800 ! cloudy streams depending on cloud fraction
801
2/2
✓ Branch 0 taken 26881540 times.
✓ Branch 1 taken 126003640 times.
 152885180 IF (ISTCLD(I_LEV) == 1) THEN
802 26881540 Z_CLDRADU(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLU1(IPR)
803 26881540 Z_CLRRADU(IPR) = Z_RADLU1(IPR) - Z_CLDRADU(IPR)
804 Z_OLDCLD(IPR) = Z_CLDRADU(IPR)
805 Z_OLDCLR(IPR) = Z_CLRRADU(IPR)
806 26881540 Z_RAD(IPR) = 0.0_JPRB
807 ENDIF
808 152885180 Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX)
809 152885180 Z_TRNS = 1.0_JPRB - P_ABSS1(INDEX)
810 152885180 Z_CLDSRC = Z_BBUTOT1(INDEX) * Z_ATOT1(INDEX)
811
812 !- Separate RT equations for clear and cloudy streams
813 152885180 Z_CLDRADU(IPR) = Z_CLDRADU(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC
814 152885180 Z_CLRRADU(IPR) = Z_CLRRADU(IPR) * Z_TRNS +(1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC
815 !***
816
817 !- total sky upward flux
818 152885180 Z_RADLU1(IPR) = Z_CLDRADU(IPR) + Z_CLRRADU(IPR)
819 152885180 Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
820
821 !- clear-sky upward flux
822 Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR) + (Z_BBU1(INDEX)-Z_RADCLRU1(IPR))&
823 152885180 & *P_ABSS1(INDEX)
824 152885180 Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
825
826 !* Code to account for maximum/random overlap:
827 ! Performs RT on the radiance most recently switched between clear and
828 ! cloudy streams
829 Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1(I_LEV+1) * Z_TRNS +&
830 & Z_FACCLD1(I_LEV+1) * Z_TTOT) - &
831 & Z_FACCMB1(I_LEV+1) * Z_GASSRC + &
832 152885180 & Z_FACCMB2(I_LEV+1) * Z_CLDSRC
833
834 ! Computes what the clear and cloudy streams would have been had no
835 ! radiance been switched
836 152885180 Z_OLDCLD(IPR) = Z_CLDRADU(IPR) - Z_RADMOD
837 152885180 Z_OLDCLR(IPR) = Z_CLRRADU(IPR) + Z_RADMOD
838
839 ! Computes the radiance to be switched between clear and cloudy.
840 Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2(I_LEV+1)*Z_OLDCLR(IPR) -&
841 152885180 & Z_FACCLD2(I_LEV+1)*Z_OLDCLD(IPR)
842 152885180 Z_CLDRADU(IPR) = Z_CLDRADU(IPR) + Z_RAD(IPR)
843 153977217 Z_CLRRADU(IPR) = Z_CLRRADU(IPR) - Z_RAD(IPR)
844 !***
845 ENDDO
846
847 ELSE
848
849 !- *** Clear layer
850 3559883 IENT = JPGPT * (I_LEV-1)
851
2/2
✓ Branch 0 taken 3559883 times.
✓ Branch 1 taken 498383620 times.
 501943503 DO IPR = 1, JPGPT
852 498383620 INDEX = IENT + IPR
853 !- total-sky upward flux
854 498383620 Z_RADLU1(IPR) = Z_RADLU1(IPR)+(Z_BBU1(INDEX)-Z_RADLU1(IPR))*P_ABSS1(INDEX)
855 498383620 Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
856 !- clear-sky upward flux
857 ! Upward clear and total sky streams must be separate because surface
858 ! reflectance is different for each.
859 498383620 Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR)+(Z_BBU1(INDEX)-Z_RADCLRU1(IPR))*P_ABSS1(INDEX)
860 501943503 Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
861 ENDDO
862
863 ENDIF
864
865 4651920 P_TOTUFLUC(I_LEV) = Z_URADCL1 * Z_WTNUM(1)
866 4771200 P_TOTUFLUX(I_LEV) = Z_URAD1 * Z_WTNUM(1)
867
868 ENDDO
869
870 !* Convert radiances to fluxes and heating rates for total and clear sky.
871 ! ** NB: moved to calling routine
872 ! TOTUFLUC(0) = TOTUFLUC(0) * FLUXFAC
873 ! TOTDFLUC(0) = TOTDFLUC(0) * FLUXFAC
874 ! TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC
875 ! TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC
876
877 ! CLFNET(0) = (P_TOTUFLUC(0) - P_TOTDFLUC(0))
878 ! FNET(0) = (P_TOTUFLUX(0) - P_TOTDFLUX(0))
879 ! DO LEV = 1, KLEV
880 ! TOTUFLUC(LEV) = TOTUFLUC(LEV) * FLUXFAC
881 ! TOTDFLUC(LEV) = TOTDFLUC(LEV) * FLUXFAC
882 ! CLFNET(LEV) =(P_TOTUFLUC(LEV) - P_TOTDFLUC(LEV))
883
884 ! TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC
885 ! TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC
886 ! FNET(LEV) = (P_TOTUFLUX(LEV) - P_TOTDFLUX(LEV))
887 ! L = LEV - 1
888
889 !- Calculate Heating Rates.
890 ! CLHTR(L)=HEATFAC*(CLFNET(L)-CLFNET(LEV))/(PZ(L)-PZ(LEV))
891 ! HTR(L) =HEATFAC*(FNET(L) -FNET(LEV)) /(PZ(L)-PZ(LEV))
892 ! END DO
893 ! CLHTR(KLEV) = 0.0
894 ! HTR(KLEV) = 0.0
895
896
897
898
1/2
✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
 119280 IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',1,ZHOOK_HANDLE)
899 119280 END SUBROUTINE RRTM_RTRN1A_140GP
900