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