source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phymar/olwc.F90 @ 4031

Last change on this file since 4031 was 3990, checked in by millour, 8 years ago

An updated LMDZ5 (based on LMDZ rev 2786) to play with.
EM
File size: 9.3 KB
Line 
1SUBROUTINE OLWC ( KIDIA,KFDIA,KLON,KLEV &
2     &  , PBINT,PBSUIN,PCLDLD,PCLDLU,PCNTRB,PEMIS,PFDN,PFUP &
3     &  , PFLUX                                                 )
4!
5!**** *LWC*   - LONGWAVE RADIATION, CLOUD EFFECTS
6!
7!     PURPOSE.
8!     --------
9!           INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
10!           RADIANCES
11!
12!**   INTERFACE.
13!     ----------
14!
15!        EXPLICIT ARGUMENTS :
16!        --------------------
17!     ==== INPUTS ===
18! PBINT  : (KLON,KLEV+1)     ; HALF LEVEL PLANCK FUNCTION
19! PBSUIN : (KLON)            ; SURFACE PLANCK FUNCTION
20! PCLDLD : (KLON,KLEV)       ; DOWNWARD EFFECTIVE CLOUD FRACTION
21! PCLDLU : (KLON,KLEV)       ; UPWARD EFFECTIVE CLOUD FRACTION
22! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE
23! PEMIS  : (KLON)            ; SURFACE EMISSIVITY
24! PFDN   : (KLON,KLEV+1)     ; CLEAR-SKY DOWNWARD FLUX
25! PFUP   : (KLON,KLEV+1)     ; CLEAR-SKY UPWARD FLUX
26!     ==== OUTPUTS ===
27! PFLUX(KLON,2,KLEV)         ; RADIATIVE FLUXES :
28!                     1  ==>  UPWARD   FLUX TOTAL
29!                     2  ==>  DOWNWARD FLUX TOTAL
30!
31!        IMPLICIT ARGUMENTS :   NONE
32!        --------------------
33!
34!     METHOD.
35!     -------
36!
37!          1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
38!          2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
39!          3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
40!     CLOUDS
41!
42!     EXTERNALS.
43!     ----------
44!
45!          NONE
46!
47!     REFERENCE.
48!     ----------
49!
50!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
51!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
52!
53!     AUTHOR.
54!     -------
55!        JEAN-JACQUES MORCRETTE  *ECMWF*
56!
57!     MODIFICATIONS.
58!     --------------
59!        ORIGINAL : 89-07-14
60!-----------------------------------------------------------------------
61
62#include "tsmbkind.h"
63
64USE YOERAD   , ONLY : NOVLP
65USE YOERDI   , ONLY : REPCLC
66USE YOEDBUG  , ONLY : LDEBUG
67
68
69IMPLICIT NONE
70
71
72
73!     DUMMY INTEGER SCALARS
74INTEGER_M :: KFDIA
75INTEGER_M :: KIDIA
76INTEGER_M :: KLEV
77INTEGER_M :: KLON
78
79!-----------------------------------------------------------------------
80!
81!*       0.1   ARGUMENTS
82!              ---------
83!
84REAL_B :: PBINT(KLON,KLEV+1),PBSUIN(KLON),PCLDLD(KLON,KLEV) &
85     &  ,  PCLDLU(KLON,KLEV) &
86     &  ,  PCNTRB(KLON,KLEV+1,KLEV+1) &
87     &  ,  PFDN(KLON,KLEV+1),PFUP(KLON,KLEV+1) &
88     &  ,  PEMIS(KLON)
89!
90REAL_B :: PFLUX(KLON,2,KLEV+1)
91!
92!-----------------------------------------------------------------------
93!
94!*       0.2   LOCAL ARRAYS
95!              ------------
96!
97INTEGER_M :: IMX(KLON), IMXP(KLON)
98!
99REAL_B :: ZCLEAR(KLON),ZCLOUD(KLON),ZDNF(KLON,KLEV+1,KLEV+1) &
100     &  , ZFD(KLON), ZFN10(KLON), ZFU(KLON) &
101     &  , ZUPF(KLON,KLEV+1,KLEV+1) &
102     &  , ZCLM(KLON,KLEV+1,KLEV+1)
103!
104!     LOCAL INTEGER SCALARS
105INTEGER_M :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,&
106             &JK, JK1, JK2, JKJ, JL, IMX1, IMX2, JKC, JKCP1, JKM1, JKP1
107
108!     LOCAL REAL SCALARS
109REAL_B :: ZCFRAC
110
111!     ------------------------------------------------------------------
112!
113!*         1.     INITIALIZATION
114!                 --------------
115!
116IMAXC = 0
117!
118DO JL = KIDIA,KFDIA
119  IMX(JL)=0
120  IMXP(JL)=0
121  ZCLOUD(JL) = 0.
122END DO
123!
124!*         1.1    SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
125!                 -------------------------------------------
126!
127DO JK = 1 , KLEV
128  DO JL = KIDIA,KFDIA
129    IMX1=IMX(JL)
130    IMX2=JK
131    IF (PCLDLU(JL,JK).GT.REPCLC) THEN
132      IMXP(JL)=IMX2
133    ELSE
134      IMXP(JL)=IMX1
135    END IF
136    IMAXC=MAX(IMXP(JL),IMAXC)
137    IMX(JL)=IMXP(JL)
138  END DO
139END DO
140!CGM*******
141IMAXC=KLEV
142!CGM*******
143!
144DO JK = 1 , KLEV+1
145  DO JL = KIDIA,KFDIA
146    PFLUX(JL,1,JK) = PFUP(JL,JK)
147    PFLUX(JL,2,JK) = PFDN(JL,JK)
148  END DO
149END DO
150!
151!     ------------------------------------------------------------------
152!
153!*         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
154!                  ---------------------------------------
155!
156IF (IMAXC.GT.0) THEN
157!
158  IMXP1 = IMAXC + 1
159  IMXM1 = IMAXC - 1
160!
161!*         2.0     INITIALIZE TO CLEAR-SKY FLUXES
162!                  ------------------------------
163!
164  DO JK1=1,KLEV+1
165    DO JK2=1,KLEV+1
166      DO JL = KIDIA,KFDIA
167        ZUPF(JL,JK2,JK1)=PFUP(JL,JK1)
168        ZDNF(JL,JK2,JK1)=PFDN(JL,JK1)
169      END DO
170    END DO
171  END DO
172!
173!*         2.1     FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
174!                  ----------------------------------------------
175!
176  DO JKC = 1 , IMAXC
177    JCLOUD=JKC
178    JKCP1=JCLOUD+1
179!
180!*         2.1.1   ABOVE THE CLOUD
181!                  ---------------
182!
183    DO JK=JKCP1,KLEV+1
184      JKM1=JK-1
185      DO JL = KIDIA,KFDIA
186        ZFU(JL)=0.
187      END DO
188      IF (JK .GT. JKCP1) THEN
189        DO JKJ=JKCP1,JKM1
190          DO JL = KIDIA,KFDIA
191            ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
192          END DO
193        END DO
194      END IF
195!
196      DO JL = KIDIA,KFDIA
197        ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
198      END DO
199    END DO
200!
201!*         2.1.2   BELOW THE CLOUD
202!                  ---------------
203!
204    DO JK=1,JCLOUD
205      JKP1=JK+1
206      DO JL = KIDIA,KFDIA
207        ZFD(JL)=0.
208      END DO
209!
210      IF (JK .LT. JCLOUD) THEN
211        DO JKJ=JKP1,JCLOUD
212          DO JL = KIDIA,KFDIA
213            ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
214          END DO
215        END DO
216      END IF
217      DO JL = KIDIA,KFDIA
218        ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
219      END DO
220    END DO
221!
222  END DO
223!
224!
225!*         2.2     CLOUD COVER MATRIX
226!                  ------------------
227!
228!*    ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
229!     HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
230!
231  DO JK1 = 1 , KLEV+1
232    DO JK2 = 1 , KLEV+1
233      DO JL = KIDIA,KFDIA
234        ZCLM(JL,JK1,JK2) = 0.
235      END DO
236    END DO
237  END DO
238!
239!
240!
241!*         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
242!                  ------------------------------------------
243!
244  DO JK1 = 2 , KLEV+1
245    DO JL = KIDIA,KFDIA
246      ZCLEAR(JL)=1.
247      ZCLOUD(JL)=0.
248    END DO
249    DO JK = JK1 - 1 , 1 , -1
250      DO JL = KIDIA,KFDIA
251        IF (NOVLP.EQ.1) THEN
252!* maximum-random       
253          ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) &
254          &                       /(1.0-MIN(ZCLOUD(JL),1.-REPCLC))
255          ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
256          ZCLOUD(JL) = PCLDLU(JL,JK)
257        ELSE IF (NOVLP.EQ.2) THEN
258!* maximum     
259          ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
260          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
261        ELSE IF (NOVLP.EQ.3) THEN
262!* random     
263          ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
264          ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
265          ZCLM(JL,JK1,JK) = ZCLOUD(JL)
266        END IF
267      END DO
268    END DO
269  END DO
270!
271!
272!*         2.5     CLOUD COVER ABOVE THE LEVEL OF CALCULATION
273!                  ------------------------------------------
274!
275  DO JK1 = 1 , KLEV
276    DO JL = KIDIA,KFDIA
277      ZCLEAR(JL)=1.
278      ZCLOUD(JL)=0.
279    END DO
280    DO JK = JK1 , KLEV
281      DO JL = KIDIA,KFDIA
282        IF (NOVLP.EQ.1) THEN
283!* maximum-random       
284           ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) &
285           &                    /(1.0-MIN(ZCLOUD(JL),1.-REPCLC))
286           ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
287           ZCLOUD(JL) = PCLDLD(JL,JK)
288         ELSE IF (NOVLP.EQ.2) THEN
289!* maximum     
290           ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
291           ZCLM(JL,JK1,JK) = ZCLOUD(JL)
292         ELSE IF (NOVLP.EQ.3) THEN
293!* random     
294           ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
295           ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
296           ZCLM(JL,JK1,JK) = ZCLOUD(JL)
297         END IF
298       END DO
299     END DO
300   END DO
301!
302!
303!
304!*         3.      FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
305!                  ----------------------------------------------
306!
307!*         3.1     DOWNWARD FLUXES
308!                  ---------------
309!
310  DO JL = KIDIA,KFDIA
311    PFLUX(JL,2,KLEV+1) = 0.
312  END DO
313!
314  DO JK1 = KLEV , 1 , -1
315!
316!*                 CONTRIBUTION FROM CLEAR-SKY FRACTION
317!
318    DO JL = KIDIA,KFDIA
319      ZFD (JL) = (1. - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1)
320!
321!*                 CONTRIBUTION FROM ADJACENT CLOUD
322!
323      ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
324    END DO
325!
326!*                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
327!
328    DO JK = KLEV-1 , JK1 , -1
329      DO JL = KIDIA,KFDIA
330        ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
331        ZFD(JL) =  ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
332      END DO
333    END DO
334!
335    DO JL = KIDIA,KFDIA
336      PFLUX(JL,2,JK1) = ZFD (JL)
337    END DO
338!
339  END DO
340!
341!
342!
343!
344!*         3.2     UPWARD FLUX AT THE SURFACE
345!                  --------------------------
346!
347  DO JL = KIDIA,KFDIA
348    PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1)
349  END DO
350!
351!
352!
353!*         3.3     UPWARD FLUXES
354!                  -------------
355!
356  DO JK1 = 2 , KLEV+1
357!
358!*                 CONTRIBUTION FROM CLEAR-SKY FRACTION
359!
360    DO JL = KIDIA,KFDIA
361      ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
362!
363!*                 CONTRIBUTION FROM ADJACENT CLOUD
364!
365      ZFU(JL) =  ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
366    END DO
367!
368!*                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
369!
370    DO JK = 2 , JK1-1
371      DO JL = KIDIA,KFDIA
372        ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
373        ZFU(JL) =  ZFU(JL) + ZCFRAC * ZUPF(JL,JK  ,JK1)
374      END DO
375    END DO
376!
377    DO JL = KIDIA,KFDIA
378      PFLUX(JL,1,JK1) = ZFU (JL)
379    END DO
380!
381  END DO
382!
383!
384END IF
385!
386!
387!*         2.3     END OF CLOUD EFFECT COMPUTATIONS
388!
389!----------------------------------------------------------------------
390RETURN
391END SUBROUTINE OLWC
Note: See TracBrowser for help on using the repository browser.