GCC Code Coverage Report


Directory: ./
File: rad/lwc.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 117 0.0%
Branches: 0 108 0.0%

Line Branch Exec Source
1 SUBROUTINE LWC &
2 & ( KIDIA , KFDIA, KLON , KLEV,&
3 & PBINT , PBSUI, PCLDLD, PCLDLU,&
4 & PCNTRB, PEMIT, PFLUC,&
5 & PFLUX &
6 & )
7
8 !**** *LWC* - LONGWAVE RADIATION, CLOUD EFFECTS
9
10 ! PURPOSE.
11 ! --------
12 ! INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
13 ! RADIANCES
14
15 !** INTERFACE.
16 ! ----------
17
18 ! EXPLICIT ARGUMENTS :
19 ! --------------------
20 ! ==== INPUTS ===
21 ! PBINT : (KLON,KLEV+1) ; HALF LEVEL PLANCK FUNCTION
22 ! PBSUI : (KLON) ; SURFACE PLANCK FUNCTION
23 ! PCLDLD : (KLON,KLEV) ; DOWNWARD EFFECTIVE CLOUD FRACTION
24 ! PCLDLU : (KLON,KLEV) ; UPWARD EFFECTIVE CLOUD FRACTION
25 ! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
26 ! PEMIT : (KLON) ; SURFACE TOTAL LW EMISSIVITY
27 ! PFLUC : (KLON,2,KLEV+1) ; CLEAR-SKY LW RADIATIVE FLUXES
28 ! ==== OUTPUTS ===
29 ! PFLUX : (KLON,2,KLEV+1) ; TOTAL SKY LW RADIATIVE FLUXES :
30 ! 1 ==> UPWARD FLUX TOTAL
31 ! 2 ==> DOWNWARD FLUX TOTAL
32
33 ! IMPLICIT ARGUMENTS : NONE
34 ! --------------------
35
36 ! METHOD.
37 ! -------
38
39 ! 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
40 ! 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
41 ! 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
42 ! CLOUDS
43
44 ! EXTERNALS.
45 ! ----------
46
47 ! NONE
48
49 ! REFERENCE.
50 ! ----------
51
52 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
53 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
54
55 ! AUTHOR.
56 ! -------
57 ! JEAN-JACQUES MORCRETTE *ECMWF*
58
59 ! MODIFICATIONS.
60 ! --------------
61 ! ORIGINAL : 89-07-14
62 ! JJ Morcrette 97-04-18 Cleaning
63 ! JJMorcrette 01-02-16 Hogan & Illingworth (2001)'s mixed overlap
64 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
65
66 !-----------------------------------------------------------------------
67
68 USE PARKIND1 ,ONLY : JPIM ,JPRB
69 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
70
71 USE YOERAD , ONLY : NOVLP
72 USE YOERDI , ONLY : REPCLC
73 USE YOEOVLP , ONLY : RA1OVLP
74
75 IMPLICIT NONE
76
77 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
78 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
79 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
80 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
81 REAL(KIND=JPRB) ,INTENT(IN) :: PBINT(KLON,KLEV+1)
82 REAL(KIND=JPRB) ,INTENT(IN) :: PBSUI(KLON)
83 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDLD(KLON,KLEV)
84 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDLU(KLON,KLEV)
85 REAL(KIND=JPRB) ,INTENT(IN) :: PCNTRB(KLON,KLEV+1,KLEV+1)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIT(KLON)
87 REAL(KIND=JPRB) ,INTENT(IN) :: PFLUC(KLON,2,KLEV+1)
88 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1)
89 !-----------------------------------------------------------------------
90
91 !* 0.1 ARGUMENTS
92 ! ---------
93
94 !-----------------------------------------------------------------------
95
96 ! ------------
97
98 REAL(KIND=JPRB) :: ZCLEAR(KLON) , ZCLOUD(KLON)&
99 & , ZCLM(KLON,KLEV+1,KLEV+1), ZDNF(KLON,KLEV+1,KLEV+1)&
100 & , ZFD(KLON) , ZFU(KLON)&
101 & , ZUPF(KLON,KLEV+1,KLEV+1)
102
103 INTEGER(KIND=JPIM) :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,&
104 & JK, JK1, JK2, JKJ, JL
105
106 REAL(KIND=JPRB) :: ZALPHA1, ZCFRAC
107 REAL(KIND=JPRB) :: ZHOOK_HANDLE
108
109 ! ------------------------------------------------------------------
110
111 !* 1. INITIALIZATION
112 ! --------------
113
114 !100 CONTINUE
115
116 ! print *,' Enter LWC '
117 IF (LHOOK) CALL DR_HOOK('LWC',0,ZHOOK_HANDLE)
118 DO JL = KIDIA,KFDIA
119 ZCLOUD(JL) = 0.0_JPRB
120 ENDDO
121
122 DO JK = 1 , KLEV+1
123 DO JL = KIDIA,KFDIA
124 PFLUX(JL,1,JK) = PFLUC(JL,1,JK)
125 PFLUX(JL,2,JK) = PFLUC(JL,2,JK)
126 ENDDO
127 ENDDO
128
129 !GM*******
130 IMAXC=KLEV
131 !GM*******
132
133 ! ------------------------------------------------------------------
134
135 !* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
136 ! ---------------------------------------
137
138 IMXP1 = IMAXC + 1
139 IMXM1 = IMAXC - 1
140
141 !* 2.0 INITIALIZE TO CLEAR-SKY FLUXES
142 ! ------------------------------
143
144 !200 CONTINUE
145
146 DO JK1=1,KLEV+1
147 DO JK2=1,KLEV+1
148 DO JL = KIDIA,KFDIA
149 ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1)
150 ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1)
151 ENDDO
152 ENDDO
153 ENDDO
154 ! print *,' LWC after Initialisation to clear-sky fluxes'
155
156 !* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
157 ! ----------------------------------------------
158
159 !210 CONTINUE
160
161 DO JCLOUD = 1 , IMAXC
162 IKCP1=JCLOUD+1
163
164 !* 2.1.1 ABOVE THE CLOUD
165 ! ---------------
166
167 !2110 CONTINUE
168
169 DO JK=IKCP1,KLEV+1
170 IKM1=JK-1
171 DO JL = KIDIA,KFDIA
172 ZFU(JL)=0.0_JPRB
173 ENDDO
174
175 IF (JK > IKCP1) THEN
176 DO JKJ=IKCP1,IKM1
177 DO JL = KIDIA,KFDIA
178 ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
179 ENDDO
180 ENDDO
181 ENDIF
182
183 DO JL = KIDIA,KFDIA
184 ZUPF(JL,IKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
185 ENDDO
186 ENDDO
187
188 !* 2.1.2 BELOW THE CLOUD
189 ! ---------------
190
191 !2120 CONTINUE
192
193 DO JK=1,JCLOUD
194 IKP1=JK+1
195 DO JL = KIDIA,KFDIA
196 ZFD(JL)=0.0_JPRB
197 ENDDO
198
199 IF (JK < JCLOUD) THEN
200 DO JKJ=IKP1,JCLOUD
201 DO JL = KIDIA,KFDIA
202 ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
203 ENDDO
204 ENDDO
205 ENDIF
206
207 DO JL = KIDIA,KFDIA
208 ZDNF(JL,IKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
209 ENDDO
210 ENDDO
211
212 ENDDO
213 ! print *,' LWC after 213: Fluxes for unity emissivity'
214
215 !* 2.2 CLOUD COVER MATRIX
216 ! ------------------
217
218 !* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
219 ! HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
220
221 !220 CONTINUE
222
223 DO JK1 = 1 , KLEV+1
224 DO JK2 = 1 , KLEV+1
225 DO JL = KIDIA,KFDIA
226 ZCLM(JL,JK1,JK2) = 0.0_JPRB
227 ENDDO
228 ENDDO
229 ENDDO
230 ! print *,' LWC after Initialisation CC matrix'
231
232 !* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION
233 ! ------------------------------------------
234
235 !240 CONTINUE
236
237 DO JK1 = 2 , KLEV+1
238 DO JL = KIDIA,KFDIA
239 ZCLEAR(JL)=1.0_JPRB
240 ZCLOUD(JL)=0.0_JPRB
241 ENDDO
242
243 DO JK = JK1 - 1 , 1 , -1
244 ZALPHA1=RA1OVLP(KLEV+1-JK)
245
246 DO JL = KIDIA,KFDIA
247 !++MODIFCODE
248 IF ((NOVLP==1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN
249 !--MODIFCODE
250 !* maximum-random
251 ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))&
252 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC))
253 ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL)
254 ZCLOUD(JL) = PCLDLU(JL,JK)
255 !++MODIFCODE
256 ELSEIF ((NOVLP==2).OR.(NOVLP==7)) THEN
257 !--MODIFCODE
258 !* maximum
259 ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
260 ZCLM(JL,JK1,JK) = ZCLOUD(JL)
261 !++MODIFCODE
262 ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN
263 !--MODIFCODE
264 !* random
265 ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - PCLDLU(JL,JK))
266 ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
267 ZCLM(JL,JK1,JK) = ZCLOUD(JL)
268 ELSEIF (NOVLP == 4) THEN
269 !** Hogan & Illingworth (2001)
270 ZCLEAR(JL)=ZCLEAR(JL)*( &
271 & ZALPHA1*(1.0_JPRB-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) &
272 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC)) &
273 & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDLU(JL,JK)) )
274 ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL)
275 ZCLOUD(JL) = PCLDLU(JL,JK)
276 ENDIF
277 ENDDO
278 ENDDO
279
280 ENDDO
281 ! print *,' LWC after 244: CC below level of calculation'
282
283 !* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
284 ! ------------------------------------------
285
286 !250 CONTINUE
287
288 DO JK1 = 1 , KLEV
289 DO JL = KIDIA,KFDIA
290 ZCLEAR(JL)=1.0_JPRB
291 ZCLOUD(JL)=0.0_JPRB
292 ENDDO
293
294 DO JK = JK1 , KLEV
295 ZALPHA1=RA1OVLP(KLEV+1-JK)
296
297 DO JL = KIDIA,KFDIA
298 !++MODIFCODE
299 IF ((NOVLP == 1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN
300 !--MODIFCODE
301 !* maximum-random
302 ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))&
303 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC))
304 ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL)
305 ZCLOUD(JL) = PCLDLD(JL,JK)
306 !++MODIFCODE
307 ELSEIF ((NOVLP == 2).OR.(NOVLP==7)) THEN
308 !--MODIFCODE
309 !* maximum
310 ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
311 ZCLM(JL,JK1,JK) = ZCLOUD(JL)
312 !++MODIFCODE
313 ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN
314 !--MODIFCODE
315 !* random
316 ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - PCLDLD(JL,JK))
317 ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
318 ZCLM(JL,JK1,JK) = ZCLOUD(JL)
319 ELSEIF (NOVLP == 4) THEN
320 !** Hogan & Illingworth (2001)
321 ZCLEAR(JL)=ZCLEAR(JL)*( &
322 & ZALPHA1*(1.0_JPRB-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) &
323 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC)) &
324 & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB - PCLDLD(JL,JK)) )
325 ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL)
326 ZCLOUD(JL) = PCLDLD(JL,JK)
327 ENDIF
328 ENDDO
329 ENDDO
330 ENDDO
331 ! print *,' LWC after 254: CC above level of calculation'
332
333 !* 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
334 ! ----------------------------------------------
335
336 !300 CONTINUE
337
338 !* 3.1 DOWNWARD FLUXES
339 ! ---------------
340
341 !310 CONTINUE
342
343 DO JL = KIDIA,KFDIA
344 PFLUX(JL,2,KLEV+1) = 0.0_JPRB
345 ENDDO
346
347 DO JK1 = KLEV , 1 , -1
348
349 !* CONTRIBUTION FROM CLEAR-SKY FRACTION
350
351 DO JL = KIDIA,KFDIA
352 ZFD (JL) = (1.0_JPRB - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1)
353
354 !* CONTRIBUTION FROM ADJACENT CLOUD
355
356 ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
357 ENDDO
358
359 !* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
360
361 DO JK = KLEV-1 , JK1 , -1
362 DO JL = KIDIA,KFDIA
363 ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
364 ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
365 ENDDO
366 ENDDO
367
368 DO JL = KIDIA,KFDIA
369 PFLUX(JL,2,JK1) = ZFD (JL)
370 ENDDO
371
372 ENDDO
373 ! print *,' LWC after 317: Downward fluxes'
374
375 !* 3.2 UPWARD FLUX AT THE SURFACE
376 ! --------------------------
377
378 !320 CONTINUE
379
380 DO JL = KIDIA,KFDIA
381 PFLUX(JL,1,1) = PEMIT(JL)*PBSUI(JL)-(1.0_JPRB-PEMIT(JL))*PFLUX(JL,2,1)
382 ENDDO
383
384 !* 3.3 UPWARD FLUXES
385 ! -------------
386
387 !330 CONTINUE
388
389 DO JK1 = 2 , KLEV+1
390
391 !* CONTRIBUTION FROM CLEAR-SKY FRACTION
392
393 DO JL = KIDIA,KFDIA
394 ZFU (JL) = (1.0_JPRB - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
395
396 !* CONTRIBUTION FROM ADJACENT CLOUD
397
398 ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
399 ENDDO
400
401 !* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
402
403 DO JK = 2 , JK1-1
404 DO JL = KIDIA,KFDIA
405 ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
406 ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1)
407 ENDDO
408 ENDDO
409
410 DO JL = KIDIA,KFDIA
411 PFLUX(JL,1,JK1) = ZFU (JL)
412 ENDDO
413
414 ENDDO
415 ! print *,' LWC after 337: Upward fluxes'
416
417 !-----------------------------------------------------------------------
418
419 IF (LHOOK) CALL DR_HOOK('LWC',1,ZHOOK_HANDLE)
420 END SUBROUTINE LWC
421