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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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