source: LMDZ6/branches/LMDZ-QUEST/libf/phylmd/rrtm/lwc.F90 @ 5429

Last change on this file since 5429 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 10.6 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!        JJMorcrette 01-02-16 Hogan & Illingworth (2001)'s mixed overlap
64!        M.Hamrud      01-Oct-2003 CY28 Cleaning
65
66!-----------------------------------------------------------------------
67
68USE PARKIND1  ,ONLY : JPIM     ,JPRB
69USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
70
71USE YOERAD   , ONLY : NOVLP
72USE YOERDI   , ONLY : REPCLC
73USE YOEOVLP  , ONLY : RA1OVLP
74
75IMPLICIT NONE
76
77INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
78INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
79INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
80INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
81REAL(KIND=JPRB)   ,INTENT(IN)    :: PBINT(KLON,KLEV+1)
82REAL(KIND=JPRB)   ,INTENT(IN)    :: PBSUI(KLON)
83REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDLD(KLON,KLEV)
84REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDLU(KLON,KLEV)
85REAL(KIND=JPRB)   ,INTENT(IN)    :: PCNTRB(KLON,KLEV+1,KLEV+1)
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIT(KLON)
87REAL(KIND=JPRB)   ,INTENT(IN)    :: PFLUC(KLON,2,KLEV+1)
88REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KLON,2,KLEV+1)
89!-----------------------------------------------------------------------
90
91!*       0.1   ARGUMENTS
92!              ---------
93
94!-----------------------------------------------------------------------
95
96!              ------------
97
98REAL(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
103INTEGER(KIND=JPIM) :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,&
104 & JK, JK1, JK2, JKJ, JL 
105
106REAL(KIND=JPRB) :: ZALPHA1, ZCFRAC
107REAL(KIND=JPRB) :: ZHOOK_HANDLE
108
109!     ------------------------------------------------------------------
110
111!*         1.     INITIALIZATION
112!                 --------------
113
114!100  CONTINUE
115
116!      print *,' Enter LWC '
117IF (LHOOK) CALL DR_HOOK('LWC',0,ZHOOK_HANDLE)
118DO JL = KIDIA,KFDIA
119  ZCLOUD(JL) = 0.0_JPRB
120ENDDO
121
122DO 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
127ENDDO
128
129!GM*******
130IMAXC=KLEV
131!GM*******
132
133!     ------------------------------------------------------------------
134
135!*         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
136!                  ---------------------------------------
137
138IMXP1 = IMAXC + 1
139IMXM1 = IMAXC - 1
140
141!*         2.0     INITIALIZE TO CLEAR-SKY FLUXES
142!                  ------------------------------
143
144!200  CONTINUE
145
146DO 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
153ENDDO
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
161DO 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
212ENDDO
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
223DO 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
229ENDDO
230!      print *,' LWC after Initialisation CC matrix'
231
232!*         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
233!                  ------------------------------------------
234
235!240  CONTINUE
236
237DO 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
280ENDDO
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
288DO 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
330ENDDO
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
343DO JL = KIDIA,KFDIA
344  PFLUX(JL,2,KLEV+1) = 0.0_JPRB
345ENDDO
346
347DO 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
372ENDDO
373!      print *,' LWC after 317: Downward fluxes'
374
375!*         3.2     UPWARD FLUX AT THE SURFACE
376!                  --------------------------
377
378!320  CONTINUE
379
380DO JL = KIDIA,KFDIA
381  PFLUX(JL,1,1) = PEMIT(JL)*PBSUI(JL)-(1.0_JPRB-PEMIT(JL))*PFLUX(JL,2,1)
382ENDDO
383
384!*         3.3     UPWARD FLUXES
385!                  -------------
386
387!330  CONTINUE
388
389DO 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
414ENDDO
415!      print *,' LWC after 337: Upward fluxes'
416
417!-----------------------------------------------------------------------
418
419IF (LHOOK) CALL DR_HOOK('LWC',1,ZHOOK_HANDLE)
420END SUBROUTINE LWC
Note: See TracBrowser for help on using the repository browser.