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
  INTEGER imxm1, imxp1
  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

    imxp1 = imaxc + 1
    imxm1 = imaxc - 1

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