/[lmdze]/trunk/libf/phylmd/Radlwsw/lwc.f
ViewVC logotype

Annotation of /trunk/libf/phylmd/Radlwsw/lwc.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 24 - (hide annotations)
Wed Mar 3 13:23:49 2010 UTC (14 years, 2 months ago) by guez
File size: 10389 byte(s)
Created directory "phylmd/Radlwsw". Split "radlwsw.f" in files
containing a single procedure.

Removed variable "itaufinp1" in "leapfrog".

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

  ViewVC Help
Powered by ViewVC 1.1.21