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 
64 !-----------------------------------------------------------------------
65 
66 #include "tsmbkind.h"
67 
68 USE yoerad , ONLY : novlp
69 USE yoerdi , ONLY : repclc
70 USE yoeovlp , ONLY : ra1ovlp
71 
72 
73 IMPLICIT NONE
74 
75 
76 ! DUMMY INTEGER SCALARS
77 integer_m :: kfdia
78 integer_m :: kidia
79 integer_m :: klev
80 integer_m :: klon
81 
82 
83 
84 !-----------------------------------------------------------------------
85 
86 !* 0.1 ARGUMENTS
87 ! ---------
88 
89 real_b ::&
90  &pbint(klon,klev+1), pbsui(klon) &
91  &, pcldld(klon,klev) , pcldlu(klon,klev)&
92  &, pcntrb(klon,klev+1,klev+1)&
93  &, pemit(klon)&
94  &, pfluc(klon,2,klev+1)
95 
96 real_b :: pflux(klon,2,klev+1)
97 
98 !-----------------------------------------------------------------------
99 
100 !* 0.2 LOCAL ARRAYS
101 ! ------------
102 
103 real_b :: zclear(klon) , zcloud(klon)&
104  &, zclm(klon,klev+1,klev+1), zdnf(klon,klev+1,klev+1)&
105  &, zfd(klon) , zfu(klon)&
106  &, zupf(klon,klev+1,klev+1)
107 
108 ! LOCAL INTEGER SCALARS
109 integer_m :: ikcp1, ikm1, ikp1, imaxc, imxm1, imxp1, jcloud,&
110  &jk, jk1, jk2, jkj, jl
111 
112 ! LOCAL REAL SCALARS
113 real_b :: zalpha1, zcfrac
114 
115 
116 ! ------------------------------------------------------------------
117 
118 !* 1. INITIALIZATION
119 ! --------------
120 
121 !100 CONTINUE
122 
123 !print *,' Enter LWC '
124 DO jl = kidia,kfdia
125  zcloud(jl) = _zero_
126 ENDDO
127 
128 DO jk = 1 , klev+1
129  DO jl = kidia,kfdia
130  pflux(jl,1,jk) = pfluc(jl,1,jk)
131  pflux(jl,2,jk) = pfluc(jl,2,jk)
132  ENDDO
133 ENDDO
134 
135 !GM*******
136 imaxc=klev
137 !GM*******
138 
139 
140 ! ------------------------------------------------------------------
141 
142 !* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
143 ! ---------------------------------------
144 
145 
146 imxp1 = imaxc + 1
147 imxm1 = imaxc - 1
148 
149 !* 2.0 INITIALIZE TO CLEAR-SKY FLUXES
150 ! ------------------------------
151 
152 !200 CONTINUE
153 
154 DO jk1=1,klev+1
155  DO jk2=1,klev+1
156  DO jl = kidia,kfdia
157  zupf(jl,jk2,jk1)=pfluc(jl,1,jk1)
158  zdnf(jl,jk2,jk1)=pfluc(jl,2,jk1)
159  ENDDO
160  ENDDO
161 ENDDO
162 !print *,' LWC after Initialisation to clear-sky fluxes'
163 
164 !* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
165 ! ----------------------------------------------
166 
167 !210 CONTINUE
168 
169 DO jcloud = 1 , imaxc
170  ikcp1=jcloud+1
171 
172 !* 2.1.1 ABOVE THE CLOUD
173 ! ---------------
174 
175 !2110 CONTINUE
176 
177  DO jk=ikcp1,klev+1
178  ikm1=jk-1
179  DO jl = kidia,kfdia
180  zfu(jl)=_zero_
181  ENDDO
182 
183  IF (jk > ikcp1) THEN
184  DO jkj=ikcp1,ikm1
185  DO jl = kidia,kfdia
186  zfu(jl) = zfu(jl) + pcntrb(jl,jk,jkj)
187  ENDDO
188  ENDDO
189  ENDIF
190 
191  DO jl = kidia,kfdia
192  zupf(jl,ikcp1,jk)=pbint(jl,jk)-zfu(jl)
193  ENDDO
194  ENDDO
195 
196 !* 2.1.2 BELOW THE CLOUD
197 ! ---------------
198 
199 !2120 CONTINUE
200 
201  DO jk=1,jcloud
202  ikp1=jk+1
203  DO jl = kidia,kfdia
204  zfd(jl)=_zero_
205  ENDDO
206 
207  IF (jk < jcloud) THEN
208  DO jkj=ikp1,jcloud
209  DO jl = kidia,kfdia
210  zfd(jl) = zfd(jl) + pcntrb(jl,jk,jkj)
211  ENDDO
212  ENDDO
213  ENDIF
214 
215  DO jl = kidia,kfdia
216  zdnf(jl,ikcp1,jk)=-pbint(jl,jk)-zfd(jl)
217  ENDDO
218  ENDDO
219 
220 ENDDO
221 !print *,' LWC after 213: Fluxes for unity emissivity'
222 
223 
224 !* 2.2 CLOUD COVER MATRIX
225 ! ------------------
226 
227 !* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
228 ! HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
229 
230 !220 CONTINUE
231 
232 DO jk1 = 1 , klev+1
233  DO jk2 = 1 , klev+1
234  DO jl = kidia,kfdia
235  zclm(jl,jk1,jk2) = _zero_
236  ENDDO
237  ENDDO
238 ENDDO
239 !print *,' LWC after Initialisation CC matrix'
240 
241 
242 
243 !* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION
244 ! ------------------------------------------
245 
246 !240 CONTINUE
247 
248 DO jk1 = 2 , klev+1
249  DO jl = kidia,kfdia
250  zclear(jl)=_one_
251  zcloud(jl)=_zero_
252  ENDDO
253 
254  DO jk = jk1 - 1 , 1 , -1
255  DO jl = kidia,kfdia
256  IF (novlp == 1) THEN
257 !* maximum-random
258  zclear(jl)=zclear(jl)*(_one_-max(pcldlu(jl,jk),zcloud(jl)))&
259  &/(_one_-min(zcloud(jl),_one_-repclc))
260  zclm(jl,jk1,jk) = _one_ - zclear(jl)
261  zcloud(jl) = pcldlu(jl,jk)
262  ELSEIF (novlp == 2) THEN
263 !* maximum
264  zcloud(jl) = max(zcloud(jl) , pcldlu(jl,jk))
265  zclm(jl,jk1,jk) = zcloud(jl)
266  ELSEIF (novlp == 3) THEN
267 !* random
268  zclear(jl) = zclear(jl)*(_one_ - pcldlu(jl,jk))
269  zcloud(jl) = _one_ - zclear(jl)
270  zclm(jl,jk1,jk) = zcloud(jl)
271  ELSEIF (novlp == 4) THEN
272 !** Hogan & Illingworth (2001)
273  zalpha1=ra1ovlp(klev+1-jk)
274  zclear(jl)=zclear(jl)*( &
275  & zalpha1*(_one_-max(pcldlu(jl,jk),zcloud(jl))) &
276  & /(_one_-min(zcloud(jl),_one_-repclc)) &
277  & +(_one_-zalpha1)*(_one_-pcldlu(jl,jk)) )
278  zclm(jl,jk1,jk) = _one_ - zclear(jl)
279  zcloud(jl) = pcldlu(jl,jk)
280  ENDIF
281  ENDDO
282  ENDDO
283 
284 ENDDO
285 !print *,' LWC after 244: CC below level of calculation'
286 
287 
288 !* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
289 ! ------------------------------------------
290 
291 !250 CONTINUE
292 
293 DO jk1 = 1 , klev
294  DO jl = kidia,kfdia
295  zclear(jl)=_one_
296  zcloud(jl)=_zero_
297  ENDDO
298 
299  DO jk = jk1 , klev
300  DO jl = kidia,kfdia
301  IF (novlp == 1) THEN
302 !* maximum-random
303  zclear(jl)=zclear(jl)*(_one_-max(pcldld(jl,jk),zcloud(jl)))&
304  &/(_one_-min(zcloud(jl),_one_-repclc))
305  zclm(jl,jk1,jk) = _one_ - zclear(jl)
306  zcloud(jl) = pcldld(jl,jk)
307  ELSEIF (novlp == 2) THEN
308 !* maximum
309  zcloud(jl) = max(zcloud(jl) , pcldld(jl,jk))
310  zclm(jl,jk1,jk) = zcloud(jl)
311  ELSEIF (novlp == 3) THEN
312 !* random
313  zclear(jl) = zclear(jl)*(_one_ - pcldld(jl,jk))
314  zcloud(jl) = _one_ - zclear(jl)
315  zclm(jl,jk1,jk) = zcloud(jl)
316  ELSEIF (novlp == 4) THEN
317 !** Hogan & Illingworth (2001)
318  zalpha1=ra1ovlp(klev+1-jk)
319  zclear(jl)=zclear(jl)*( &
320  & zalpha1*(_one_-max(pcldld(jl,jk),zcloud(jl))) &
321  & /(_one_-min(zcloud(jl),_one_-repclc)) &
322  & +(_one_-zalpha1)*(_one_ - pcldld(jl,jk)) )
323  zclm(jl,jk1,jk) = _one_ - zclear(jl)
324  zcloud(jl) = pcldld(jl,jk)
325  ENDIF
326  ENDDO
327  ENDDO
328 ENDDO
329 !print *,' LWC after 254: CC above level of calculation'
330 
331 
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) = _zero_
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) = (_one_ - 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 
376 
377 
378 !* 3.2 UPWARD FLUX AT THE SURFACE
379 ! --------------------------
380 
381 !320 CONTINUE
382 
383 DO jl = kidia,kfdia
384  pflux(jl,1,1) = pemit(jl)*pbsui(jl)-(_one_-pemit(jl))*pflux(jl,2,1)
385 ENDDO
386 
387 
388 
389 !* 3.3 UPWARD FLUXES
390 ! -------------
391 
392 !330 CONTINUE
393 
394 DO jk1 = 2 , klev+1
395 
396 !* CONTRIBUTION FROM CLEAR-SKY FRACTION
397 
398  DO jl = kidia,kfdia
399  zfu(jl) = (_one_ - zclm(jl,jk1,1)) * zupf(jl,1,jk1)
400 
401 !* CONTRIBUTION FROM ADJACENT CLOUD
402 
403  zfu(jl) = zfu(jl) + zclm(jl,jk1,jk1-1) * zupf(jl,jk1,jk1)
404  ENDDO
405 
406 !* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
407 
408  DO jk = 2 , jk1-1
409  DO jl = kidia,kfdia
410  zcfrac = zclm(jl,jk1,jk-1) - zclm(jl,jk1,jk)
411  zfu(jl) = zfu(jl) + zcfrac * zupf(jl,jk ,jk1)
412  ENDDO
413  ENDDO
414 
415  DO jl = kidia,kfdia
416  pflux(jl,1,jk1) = zfu(jl)
417  ENDDO
418 
419 ENDDO
420 ! print *,' LWC after 337: Upward fluxes'
421 
422 !-----------------------------------------------------------------------
423 
424 RETURN
425 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
lwc
subroutine lwc(KIDIA, KFDIA, KLON, KLEV, PBINT, PBSUI, PCLDLD, PCLDLU, PCNTRB, PEMIT, PFLUC, PFLUX)
Definition: lwc.F90:7
yoerad
Definition: yoerad.F90:1
yoeovlp::ra1ovlp
real(kind=jprb), dimension(:), allocatable ra1ovlp
Definition: yoeovlp.F90:13
yoerdi::repclc
real(kind=jprb) repclc
Definition: yoerdi.F90:21