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	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	ELSE
104	imxp(jl) = imx1
105	END IF
106	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