phylmd/Radlwsw/lwc.f

SUBROUTINE lwc(klim, pcldld, pcldlu, pemis, pfluc, pbint, pbsuin, pcts, &
    pcntrb, pflux)
  USE dimens_m
  USE dimphy
  USE raddim
  USE radepsi
  USE radopt
  IMPLICIT NONE

  ! PURPOSE.
  ! --------
  ! INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
  ! RADIANCES

  ! EXPLICIT ARGUMENTS :
  ! --------------------
  ! ==== INPUTS ===
  ! PBINT  : (KDLON,0:KFLEV)     ; HALF LEVEL PLANCK FUNCTION
  ! PBSUIN : (KDLON)             ; SURFACE PLANCK FUNCTION
  ! PCLDLD : (KDLON,KFLEV)       ; DOWNWARD EFFECTIVE CLOUD FRACTION
  ! PCLDLU : (KDLON,KFLEV)       ; UPWARD EFFECTIVE CLOUD FRACTION
  ! PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE
  ! PCTS   : (KDLON,KFLEV)       ; CLEAR-SKY LAYER COOLING-TO-SPACE
  ! PEMIS  : (KDLON)             ; SURFACE EMISSIVITY
  ! PFLUC
  ! ==== OUTPUTS ===
  ! PFLUX(KDLON,2,KFLEV)         ; RADIATIVE FLUXES :
  ! 1  ==>  UPWARD   FLUX TOTAL
  ! 2  ==>  DOWNWARD FLUX TOTAL

  ! METHOD.
  ! -------

  ! 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
  ! 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
  ! 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
  ! CLOUDS

  ! REFERENCE.
  ! ----------

  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

  ! AUTHOR.
  ! -------
  ! JEAN-JACQUES MORCRETTE  *ECMWF*

  ! MODIFICATIONS.
  ! --------------
  ! ORIGINAL : 89-07-14
  ! Voigt lines (loop 231 to 233)  - JJM & PhD - 01/96
  ! -----------------------------------------------------------------------
  ! * ARGUMENTS:
  INTEGER klim
  DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
  DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF LEVEL PLANCK FUNCTION
  DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
  DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) !CLEAR-SKY ENERGY EXCHANGE
  DOUBLE PRECISION pcts(kdlon, kflev) ! CLEAR-SKY LAYER COOLING-TO-SPACE

  DOUBLE PRECISION pcldld(kdlon, kflev)
  DOUBLE PRECISION pcldlu(kdlon, kflev)
  DOUBLE PRECISION pemis(kdlon)

  DOUBLE PRECISION pflux(kdlon, 2, kflev+1)
  ! -----------------------------------------------------------------------
  ! * LOCAL VARIABLES:
  INTEGER imx(kdlon), imxp(kdlon)

  DOUBLE PRECISION zclear(kdlon), zcloud(kdlon)
  DOUBLE PRECISION zdnf(kdlon, kflev+1, kflev+1), zfd(kdlon), zfn10(kdlon), &
    zfu(kdlon), zupf(kdlon, kflev+1, kflev+1)
  DOUBLE PRECISION zclm(kdlon, kflev+1, kflev+1)

  INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
  INTEGER jk1, jk2, jkc, jkcp1, jcloud
  DOUBLE PRECISION zcfrac
  ! ------------------------------------------------------------------

  ! *         1.     INITIALIZATION
  ! --------------


  imaxc = 0

  DO jl = 1, kdlon
    imx(jl) = 0
    imxp(jl) = 0
    zcloud(jl) = 0.
  END DO

  ! *         1.1    SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
  ! -------------------------------------------


  DO jk = 1, kflev
    DO jl = 1, kdlon
      imx1 = imx(jl)
      imx2 = jk
      IF (pcldlu(jl,jk)>zepsc) THEN
        imxp(jl) = imx2
      ELSE
        imxp(jl) = imx1
      END IF
      imaxc = max(imxp(jl), imaxc)
      imx(jl) = imxp(jl)
    END DO
  END DO
  ! GM*******
  imaxc = kflev
  ! GM*******

  DO jk = 1, kflev + 1
    DO jl = 1, kdlon
      pflux(jl, 1, jk) = pfluc(jl, 1, jk)
      pflux(jl, 2, jk) = pfluc(jl, 2, jk)
    END DO
  END DO

  ! ------------------------------------------------------------------

  ! *         2.      EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
  ! ---------------------------------------

  IF (imaxc>0) THEN
    ! *         2.0     INITIALIZE TO CLEAR-SKY FLUXES
    ! ------------------------------


    DO jk1 = 1, kflev + 1
      DO jk2 = 1, kflev + 1
        DO jl = 1, kdlon
          zupf(jl, jk2, jk1) = pfluc(jl, 1, jk1)
          zdnf(jl, jk2, jk1) = pfluc(jl, 2, jk1)
        END DO
      END DO
    END DO

    ! *         2.1     FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
    ! ----------------------------------------------


    DO jkc = 1, imaxc
      jcloud = jkc
      jkcp1 = jcloud + 1

      ! *         2.1.1   ABOVE THE CLOUD
      ! ---------------


      DO jk = jkcp1, kflev + 1
        jkm1 = jk - 1
        DO jl = 1, kdlon
          zfu(jl) = 0.
        END DO
        IF (jk>jkcp1) THEN
          DO jkj = jkcp1, jkm1
            DO jl = 1, kdlon
              zfu(jl) = zfu(jl) + pcntrb(jl, jk, jkj)
            END DO
          END DO
        END IF

        DO jl = 1, kdlon
          zupf(jl, jkcp1, jk) = pbint(jl, jk) - zfu(jl)
        END DO
      END DO

      ! *         2.1.2   BELOW THE CLOUD
      ! ---------------


      DO jk = 1, jcloud
        jkp1 = jk + 1
        DO jl = 1, kdlon
          zfd(jl) = 0.
        END DO

        IF (jk<jcloud) THEN
          DO jkj = jkp1, jcloud
            DO jl = 1, kdlon
              zfd(jl) = zfd(jl) + pcntrb(jl, jk, jkj)
            END DO
          END DO
        END IF
        DO jl = 1, kdlon
          zdnf(jl, jkcp1, jk) = -pbint(jl, jk) - zfd(jl)
        END DO
      END DO

    END DO


    ! *         2.2     CLOUD COVER MATRIX
    ! ------------------

    ! *    ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
    ! HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1


    DO jk1 = 1, kflev + 1
      DO jk2 = 1, kflev + 1
        DO jl = 1, kdlon
          zclm(jl, jk1, jk2) = 0.
        END DO
      END DO
    END DO


    ! *         2.4     CLOUD COVER BELOW THE LEVEL OF CALCULATION
    ! ------------------------------------------


    DO jk1 = 2, kflev + 1
      DO jl = 1, kdlon
        zclear(jl) = 1.
        zcloud(jl) = 0.
      END DO
      DO jk = jk1 - 1, 1, -1
        DO jl = 1, kdlon
          IF (novlp==1) THEN
            ! * maximum-random
            zclear(jl) = zclear(jl)*(1.0-max(pcldlu(jl, &
              jk),zcloud(jl)))/(1.0-min(zcloud(jl),1.-zepsec))
            zclm(jl, jk1, jk) = 1.0 - zclear(jl)
            zcloud(jl) = pcldlu(jl, jk)
          ELSE IF (novlp==2) THEN
            ! * maximum
            zcloud(jl) = max(zcloud(jl), pcldlu(jl,jk))
            zclm(jl, jk1, jk) = zcloud(jl)
          ELSE IF (novlp==3) THEN
            ! * random
            zclear(jl) = zclear(jl)*(1.0-pcldlu(jl,jk))
            zcloud(jl) = 1.0 - zclear(jl)
            zclm(jl, jk1, jk) = zcloud(jl)
          END IF
        END DO
      END DO
    END DO


    ! *         2.5     CLOUD COVER ABOVE THE LEVEL OF CALCULATION
    ! ------------------------------------------


    DO jk1 = 1, kflev
      DO jl = 1, kdlon
        zclear(jl) = 1.
        zcloud(jl) = 0.
      END DO
      DO jk = jk1, kflev
        DO jl = 1, kdlon
          IF (novlp==1) THEN
            ! * maximum-random
            zclear(jl) = zclear(jl)*(1.0-max(pcldld(jl, &
              jk),zcloud(jl)))/(1.0-min(zcloud(jl),1.-zepsec))
            zclm(jl, jk1, jk) = 1.0 - zclear(jl)
            zcloud(jl) = pcldld(jl, jk)
          ELSE IF (novlp==2) THEN
            ! * maximum
            zcloud(jl) = max(zcloud(jl), pcldld(jl,jk))
            zclm(jl, jk1, jk) = zcloud(jl)
          ELSE IF (novlp==3) THEN
            ! * random
            zclear(jl) = zclear(jl)*(1.0-pcldld(jl,jk))
            zcloud(jl) = 1.0 - zclear(jl)
            zclm(jl, jk1, jk) = zcloud(jl)
          END IF
        END DO
      END DO
    END DO


    ! *         3.      FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
    ! ----------------------------------------------


    ! *         3.1     DOWNWARD FLUXES
    ! ---------------


    DO jl = 1, kdlon
      pflux(jl, 2, kflev+1) = 0.
    END DO

    DO jk1 = kflev, 1, -1

      ! *                 CONTRIBUTION FROM CLEAR-SKY FRACTION

      DO jl = 1, kdlon
        zfd(jl) = (1.-zclm(jl,jk1,kflev))*zdnf(jl, 1, jk1)
      END DO

      ! *                 CONTRIBUTION FROM ADJACENT CLOUD

      DO jl = 1, kdlon
        zfd(jl) = zfd(jl) + zclm(jl, jk1, jk1)*zdnf(jl, jk1+1, jk1)
      END DO

      ! *                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS

      DO jk = kflev - 1, jk1, -1
        DO jl = 1, kdlon
          zcfrac = zclm(jl, jk1, jk+1) - zclm(jl, jk1, jk)
          zfd(jl) = zfd(jl) + zcfrac*zdnf(jl, jk+2, jk1)
        END DO
      END DO

      DO jl = 1, kdlon
        pflux(jl, 2, jk1) = zfd(jl)
      END DO

    END DO


    ! *         3.2     UPWARD FLUX AT THE SURFACE
    ! --------------------------


    DO jl = 1, kdlon
      pflux(jl, 1, 1) = pemis(jl)*pbsuin(jl) - (1.-pemis(jl))*pflux(jl, 2, 1)
    END DO


    ! *         3.3     UPWARD FLUXES
    ! -------------


    DO jk1 = 2, kflev + 1

      ! *                 CONTRIBUTION FROM CLEAR-SKY FRACTION

      DO jl = 1, kdlon
        zfu(jl) = (1.-zclm(jl,jk1,1))*zupf(jl, 1, jk1)
      END DO

      ! *                 CONTRIBUTION FROM ADJACENT CLOUD

      DO jl = 1, kdlon
        zfu(jl) = zfu(jl) + zclm(jl, jk1, jk1-1)*zupf(jl, jk1, jk1)
      END DO

      ! *                 CONTRIBUTION FROM OTHER CLOUDY FRACTIONS

      DO jk = 2, jk1 - 1
        DO jl = 1, kdlon
          zcfrac = zclm(jl, jk1, jk-1) - zclm(jl, jk1, jk)
          zfu(jl) = zfu(jl) + zcfrac*zupf(jl, jk, jk1)
        END DO
      END DO

      DO jl = 1, kdlon
        pflux(jl, 1, jk1) = zfu(jl)
      END DO

    END DO


  END IF


  ! *         2.3     END OF CLOUD EFFECT COMPUTATIONS


  IF (.NOT. levoigt) THEN
    DO jl = 1, kdlon
      zfn10(jl) = pflux(jl, 1, klim) + pflux(jl, 2, klim)
    END DO
    DO jk = klim + 1, kflev + 1
      DO jl = 1, kdlon
        zfn10(jl) = zfn10(jl) + pcts(jl, jk-1)
        pflux(jl, 1, jk) = zfn10(jl)
        pflux(jl, 2, jk) = 0.0
      END DO
    END DO
  END IF

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