source: LMDZ5/branches/testing/libf/phymar/lwc.F90 @ 4794

Last change on this file since 4794 was 2160, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand
File size: 9.7 KB
Line 
1SUBROUTINE 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
68USE YOERAD   , ONLY : NOVLP
69USE YOERDI   , ONLY : REPCLC
70USE YOEOVLP  , ONLY : RA1OVLP
71
72
73IMPLICIT NONE
74
75
76!     DUMMY INTEGER SCALARS
77INTEGER_M :: KFDIA
78INTEGER_M :: KIDIA
79INTEGER_M :: KLEV
80INTEGER_M :: KLON
81
82
83
84!-----------------------------------------------------------------------
85
86!*       0.1   ARGUMENTS
87!              ---------
88
89REAL_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
96REAL_B :: PFLUX(KLON,2,KLEV+1)
97
98!-----------------------------------------------------------------------
99
100!*       0.2   LOCAL ARRAYS
101!              ------------
102
103REAL_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
109INTEGER_M :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,&
110             &JK, JK1, JK2, JKJ, JL
111
112!     LOCAL REAL SCALARS
113REAL_B :: ZALPHA1, ZCFRAC
114
115
116!     ------------------------------------------------------------------
117
118!*         1.     INITIALIZATION
119!                 --------------
120
121!100  CONTINUE
122
123!print *,' Enter LWC '
124DO JL = KIDIA,KFDIA
125  ZCLOUD(JL) = _ZERO_
126ENDDO
127
128DO 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
133ENDDO
134
135!GM*******
136IMAXC=KLEV
137!GM*******
138
139
140!     ------------------------------------------------------------------
141
142!*         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
143!                  ---------------------------------------
144
145
146IMXP1 = IMAXC + 1
147IMXM1 = IMAXC - 1
148
149!*         2.0     INITIALIZE TO CLEAR-SKY FLUXES
150!                  ------------------------------
151
152!200  CONTINUE
153
154DO 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
161ENDDO
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
169DO 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
220ENDDO
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
232DO 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
238ENDDO
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
248DO 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
284ENDDO
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
293DO 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
328ENDDO
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
343DO JL = KIDIA,KFDIA
344  PFLUX(JL,2,KLEV+1) = _ZERO_
345ENDDO
346
347DO 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
372ENDDO
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
383DO JL = KIDIA,KFDIA
384  PFLUX(JL,1,1) = PEMIT(JL)*PBSUI(JL)-(_ONE_-PEMIT(JL))*PFLUX(JL,2,1)
385ENDDO
386
387
388
389!*         3.3     UPWARD FLUXES
390!                  -------------
391
392!330  CONTINUE
393
394DO 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
419ENDDO
420!      print *,' LWC after 337: Upward fluxes'
421
422!-----------------------------------------------------------------------
423
424RETURN
425END SUBROUTINE LWC
Note: See TracBrowser for help on using the repository browser.