LMDZ
lwc.F90
Go to the documentation of this file.
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
dimphy::kidia
integer, save kidia
Definition: dimphy.F90:6
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
yoerad::novlp
integer(kind=jpim) novlp
Definition: yoerad.F90:24
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
yoerdi
Definition: yoerdi.F90:1
dimphy::kfdia
integer, save kfdia
Definition: dimphy.F90:5
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
lwc
subroutine lwc(KIDIA, KFDIA, KLON, KLEV, PBINT, PBSUI, PCLDLD, PCLDLU, PCNTRB, PEMIT, PFLUC, PFLUX)
Definition: lwc.F90:7
yoerad
Definition: yoerad.F90:1
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
yoeovlp::ra1ovlp
real(kind=jprb), dimension(:), allocatable ra1ovlp
Definition: yoeovlp.F90:13
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
yoerdi::repclc
real(kind=jprb) repclc
Definition: yoerdi.F90:21