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