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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 7 months ago) by guez
Original Path: trunk/phylmd/Radlwsw/lwc.f
File size: 10532 byte(s)
Moved everything out of libf.
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 guez 71 DOUBLE PRECISION PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
58     DOUBLE PRECISION PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION
59     DOUBLE PRECISION PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
60     DOUBLE PRECISION PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE
61     DOUBLE PRECISION PCTS(KDLON,KFLEV) ! CLEAR-SKY LAYER COOLING-TO-SPACE
62 guez 24 c
63 guez 71 DOUBLE PRECISION PCLDLD(KDLON,KFLEV)
64     DOUBLE PRECISION PCLDLU(KDLON,KFLEV)
65     DOUBLE PRECISION PEMIS(KDLON)
66 guez 24 C
67 guez 71 DOUBLE PRECISION PFLUX(KDLON,2,KFLEV+1)
68 guez 24 C-----------------------------------------------------------------------
69     C* LOCAL VARIABLES:
70     INTEGER IMX(KDLON), IMXP(KDLON)
71     C
72 guez 71 DOUBLE PRECISION ZCLEAR(KDLON),ZCLOUD(KDLON)
73     DOUBLE PRECISION ZDNF(KDLON,KFLEV+1,KFLEV+1)
74 guez 24 S , ZFD(KDLON), ZFN10(KDLON), ZFU(KDLON)
75     S , ZUPF(KDLON,KFLEV+1,KFLEV+1)
76 guez 71 DOUBLE PRECISION ZCLM(KDLON,KFLEV+1,KFLEV+1)
77 guez 24 C
78     INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
79     INTEGER jk1, jk2, jkc, jkcp1, jcloud
80     INTEGER imxm1, imxp1
81 guez 71 DOUBLE PRECISION zcfrac
82 guez 24 C ------------------------------------------------------------------
83     C
84     C* 1. INITIALIZATION
85     C --------------
86     C
87     100 CONTINUE
88     C
89     IMAXC = 0
90     C
91     DO 101 JL = 1, KDLON
92     IMX(JL)=0
93     IMXP(JL)=0
94     ZCLOUD(JL) = 0.
95     101 CONTINUE
96     C
97     C* 1.1 SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
98     C -------------------------------------------
99     C
100     110 CONTINUE
101     C
102     DO 112 JK = 1 , KFLEV
103     DO 111 JL = 1, KDLON
104     IMX1=IMX(JL)
105     IMX2=JK
106     IF (PCLDLU(JL,JK).GT.ZEPSC) THEN
107     IMXP(JL)=IMX2
108     ELSE
109     IMXP(JL)=IMX1
110     END IF
111     IMAXC=MAX(IMXP(JL),IMAXC)
112     IMX(JL)=IMXP(JL)
113     111 CONTINUE
114     112 CONTINUE
115     CGM*******
116     IMAXC=KFLEV
117     CGM*******
118     C
119     DO 114 JK = 1 , KFLEV+1
120     DO 113 JL = 1, KDLON
121     PFLUX(JL,1,JK) = PFLUC(JL,1,JK)
122     PFLUX(JL,2,JK) = PFLUC(JL,2,JK)
123     113 CONTINUE
124     114 CONTINUE
125     C
126     C ------------------------------------------------------------------
127     C
128     C* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
129     C ---------------------------------------
130     C
131     IF (IMAXC.GT.0) THEN
132     C
133     IMXP1 = IMAXC + 1
134     IMXM1 = IMAXC - 1
135     C
136     C* 2.0 INITIALIZE TO CLEAR-SKY FLUXES
137     C ------------------------------
138     C
139     200 CONTINUE
140     C
141     DO 203 JK1=1,KFLEV+1
142     DO 202 JK2=1,KFLEV+1
143     DO 201 JL = 1, KDLON
144     ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1)
145     ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1)
146     201 CONTINUE
147     202 CONTINUE
148     203 CONTINUE
149     C
150     C* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
151     C ----------------------------------------------
152     C
153     210 CONTINUE
154     C
155     DO 213 JKC = 1 , IMAXC
156     JCLOUD=JKC
157     JKCP1=JCLOUD+1
158     C
159     C* 2.1.1 ABOVE THE CLOUD
160     C ---------------
161     C
162     2110 CONTINUE
163     C
164     DO 2115 JK=JKCP1,KFLEV+1
165     JKM1=JK-1
166     DO 2111 JL = 1, KDLON
167     ZFU(JL)=0.
168     2111 CONTINUE
169     IF (JK .GT. JKCP1) THEN
170     DO 2113 JKJ=JKCP1,JKM1
171     DO 2112 JL = 1, KDLON
172     ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
173     2112 CONTINUE
174     2113 CONTINUE
175     END IF
176     C
177     DO 2114 JL = 1, KDLON
178     ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
179     2114 CONTINUE
180     2115 CONTINUE
181     C
182     C* 2.1.2 BELOW THE CLOUD
183     C ---------------
184     C
185     2120 CONTINUE
186     C
187     DO 2125 JK=1,JCLOUD
188     JKP1=JK+1
189     DO 2121 JL = 1, KDLON
190     ZFD(JL)=0.
191     2121 CONTINUE
192     C
193     IF (JK .LT. JCLOUD) THEN
194     DO 2123 JKJ=JKP1,JCLOUD
195     DO 2122 JL = 1, KDLON
196     ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
197     2122 CONTINUE
198     2123 CONTINUE
199     END IF
200     DO 2124 JL = 1, KDLON
201     ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
202     2124 CONTINUE
203     2125 CONTINUE
204     C
205     213 CONTINUE
206     C
207     C
208     C* 2.2 CLOUD COVER MATRIX
209     C ------------------
210     C
211     C* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
212     C HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
213     C
214     220 CONTINUE
215     C
216     DO 223 JK1 = 1 , KFLEV+1
217     DO 222 JK2 = 1 , KFLEV+1
218     DO 221 JL = 1, KDLON
219     ZCLM(JL,JK1,JK2) = 0.
220     221 CONTINUE
221     222 CONTINUE
222     223 CONTINUE
223     C
224     C
225     C
226     C* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION
227     C ------------------------------------------
228     C
229     240 CONTINUE
230     C
231     DO 244 JK1 = 2 , KFLEV+1
232     DO 241 JL = 1, KDLON
233     ZCLEAR(JL)=1.
234     ZCLOUD(JL)=0.
235     241 CONTINUE
236     DO 243 JK = JK1 - 1 , 1 , -1
237     DO 242 JL = 1, KDLON
238     IF (NOVLP.EQ.1) THEN
239     c* maximum-random
240     ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))
241     * /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
242     ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
243     ZCLOUD(JL) = PCLDLU(JL,JK)
244     ELSE IF (NOVLP.EQ.2) THEN
245     c* maximum
246     ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
247     ZCLM(JL,JK1,JK) = ZCLOUD(JL)
248     ELSE IF (NOVLP.EQ.3) THEN
249     c* random
250     ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
251     ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
252     ZCLM(JL,JK1,JK) = ZCLOUD(JL)
253     END IF
254     242 CONTINUE
255     243 CONTINUE
256     244 CONTINUE
257     C
258     C
259     C* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
260     C ------------------------------------------
261     C
262     250 CONTINUE
263     C
264     DO 254 JK1 = 1 , KFLEV
265     DO 251 JL = 1, KDLON
266     ZCLEAR(JL)=1.
267     ZCLOUD(JL)=0.
268     251 CONTINUE
269     DO 253 JK = JK1 , KFLEV
270     DO 252 JL = 1, KDLON
271     IF (NOVLP.EQ.1) THEN
272     c* maximum-random
273     ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))
274     * /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
275     ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
276     ZCLOUD(JL) = PCLDLD(JL,JK)
277     ELSE IF (NOVLP.EQ.2) THEN
278     c* maximum
279     ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
280     ZCLM(JL,JK1,JK) = ZCLOUD(JL)
281     ELSE IF (NOVLP.EQ.3) THEN
282     c* random
283     ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
284     ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
285     ZCLM(JL,JK1,JK) = ZCLOUD(JL)
286     END IF
287     252 CONTINUE
288     253 CONTINUE
289     254 CONTINUE
290     C
291     C
292     C
293     C* 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
294     C ----------------------------------------------
295     C
296     300 CONTINUE
297     C
298     C* 3.1 DOWNWARD FLUXES
299     C ---------------
300     C
301     310 CONTINUE
302     C
303     DO 311 JL = 1, KDLON
304     PFLUX(JL,2,KFLEV+1) = 0.
305     311 CONTINUE
306     C
307     DO 317 JK1 = KFLEV , 1 , -1
308     C
309     C* CONTRIBUTION FROM CLEAR-SKY FRACTION
310     C
311     DO 312 JL = 1, KDLON
312     ZFD (JL) = (1. - ZCLM(JL,JK1,KFLEV)) * ZDNF(JL,1,JK1)
313     312 CONTINUE
314     C
315     C* CONTRIBUTION FROM ADJACENT CLOUD
316     C
317     DO 313 JL = 1, KDLON
318     ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
319     313 CONTINUE
320     C
321     C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
322     C
323     DO 315 JK = KFLEV-1 , JK1 , -1
324     DO 314 JL = 1, KDLON
325     ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
326     ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
327     314 CONTINUE
328     315 CONTINUE
329     C
330     DO 316 JL = 1, KDLON
331     PFLUX(JL,2,JK1) = ZFD (JL)
332     316 CONTINUE
333     C
334     317 CONTINUE
335     C
336     C
337     C
338     C
339     C* 3.2 UPWARD FLUX AT THE SURFACE
340     C --------------------------
341     C
342     320 CONTINUE
343     C
344     DO 321 JL = 1, KDLON
345     PFLUX(JL,1,1) = PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1)
346     321 CONTINUE
347     C
348     C
349     C
350     C* 3.3 UPWARD FLUXES
351     C -------------
352     C
353     330 CONTINUE
354     C
355     DO 337 JK1 = 2 , KFLEV+1
356     C
357     C* CONTRIBUTION FROM CLEAR-SKY FRACTION
358     C
359     DO 332 JL = 1, KDLON
360     ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
361     332 CONTINUE
362     C
363     C* CONTRIBUTION FROM ADJACENT CLOUD
364     C
365     DO 333 JL = 1, KDLON
366     ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
367     333 CONTINUE
368     C
369     C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
370     C
371     DO 335 JK = 2 , JK1-1
372     DO 334 JL = 1, KDLON
373     ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
374     ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1)
375     334 CONTINUE
376     335 CONTINUE
377     C
378     DO 336 JL = 1, KDLON
379     PFLUX(JL,1,JK1) = ZFU (JL)
380     336 CONTINUE
381     C
382     337 CONTINUE
383     C
384     C
385     END IF
386     C
387     C
388     C* 2.3 END OF CLOUD EFFECT COMPUTATIONS
389     C
390     230 CONTINUE
391     C
392     IF (.NOT.LEVOIGT) THEN
393     DO 231 JL = 1, KDLON
394     ZFN10(JL) = PFLUX(JL,1,KLIM) + PFLUX(JL,2,KLIM)
395     231 CONTINUE
396     DO 233 JK = KLIM+1 , KFLEV+1
397     DO 232 JL = 1, KDLON
398     ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1)
399     PFLUX(JL,1,JK) = ZFN10(JL)
400     PFLUX(JL,2,JK) = 0.0
401     232 CONTINUE
402     233 CONTINUE
403     ENDIF
404     C
405     RETURN
406     END

  ViewVC Help
Powered by ViewVC 1.1.21