phylmd/Radlwsw/swclr.f

module swclr_m

  IMPLICIT NONE

contains

  SUBROUTINE swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
       prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
       ptra1, ptra2)
    USE dimens_m
    USE dimphy
    USE raddim
    USE radepsi
    USE radopt

    ! ------------------------------------------------------------------
    ! PURPOSE.
    ! --------
    ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
    ! CLEAR-SKY COLUMN

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

    ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
    ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)

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

    ! MODIFICATIONS.
    ! --------------
    ! ORIGINAL : 94-11-15
    ! ------------------------------------------------------------------
    ! * ARGUMENTS:

    INTEGER knu
    ! -OB
    DOUBLE PRECISION flag_aer
    DOUBLE PRECISION tauae(kdlon, kflev, 2)
    DOUBLE PRECISION pizae(kdlon, kflev, 2)
    DOUBLE PRECISION cgae(kdlon, kflev, 2)
    DOUBLE PRECISION palbp(kdlon, 2)
    DOUBLE PRECISION pdsig(kdlon, kflev)
    DOUBLE PRECISION prayl(kdlon)
    DOUBLE PRECISION psec(kdlon)

    DOUBLE PRECISION pcgaz(kdlon, kflev)
    DOUBLE PRECISION ppizaz(kdlon, kflev)
    DOUBLE PRECISION pray1(kdlon, kflev+1)
    DOUBLE PRECISION pray2(kdlon, kflev+1)
    DOUBLE PRECISION prefz(kdlon, 2, kflev+1)
    DOUBLE PRECISION prj(kdlon, 6, kflev+1)
    DOUBLE PRECISION prk(kdlon, 6, kflev+1)
    DOUBLE PRECISION prmu0(kdlon, kflev+1)
    DOUBLE PRECISION ptauaz(kdlon, kflev)
    DOUBLE PRECISION ptra1(kdlon, kflev+1)
    DOUBLE PRECISION ptra2(kdlon, kflev+1)

    ! * LOCAL VARIABLES:

    DOUBLE PRECISION zc0i(kdlon, kflev+1)
    DOUBLE PRECISION zclear(kdlon)
    DOUBLE PRECISION zr21(kdlon)
    DOUBLE PRECISION zss0(kdlon)
    DOUBLE PRECISION zscat(kdlon)
    DOUBLE PRECISION ztr(kdlon, 2, kflev+1)

    INTEGER jl, jk, ja, jkl, jklp1, jaj, jkm1
    DOUBLE PRECISION ztray, zgar, zratio, zff, zfacoa, zcorae
    DOUBLE PRECISION zmue, zgap, zww, zto, zden, zmu1, zden1
    DOUBLE PRECISION zbmu0, zbmu1, zre11

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

    ! *         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
    ! --------------------------------------------


    DO jk = 1, kflev + 1
       DO ja = 1, 6
          DO jl = 1, kdlon
             prj(jl, ja, jk) = 0.
             prk(jl, ja, jk) = 0.
          END DO
       END DO
    END DO

    DO jk = 1, kflev
       DO jl = 1, kdlon
          ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
          ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
          pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
       END DO

       IF (flag_aer>0) THEN
          ! -OB
          DO jl = 1, kdlon
             ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
             ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
             ztray = prayl(jl)*pdsig(jl, jk)
             zratio = ztray/(ztray+ptauaz(jl,jk))
             zgar = pcgaz(jl, jk)
             zff = zgar*zgar
             ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)
             pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)
             ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &
                  ppizaz(jl,jk)*zff)
          END DO
       ELSE
          DO jl = 1, kdlon
             ztray = prayl(jl)*pdsig(jl, jk)
             ptauaz(jl, jk) = ztray
             pcgaz(jl, jk) = 0.
             ppizaz(jl, jk) = 1. - repsct
          END DO
       END IF ! check flag_aer
    END DO

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

    ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
    ! ----------------------------------------------


    DO jl = 1, kdlon
       zc0i(jl, kflev+1) = 0.
       zclear(jl) = 1.
       zscat(jl) = 0.
    END DO

    jk = 1
    jkl = kflev + 1 - jk
    jklp1 = jkl + 1
    DO jl = 1, kdlon
       zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
       zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
       zr21(jl) = exp(-zcorae)
       zss0(jl) = 1. - zr21(jl)

       IF (novlp==1) THEN
          ! * maximum-random
          zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
               (1.0-min(zscat(jl),1.-zepsec))
          zc0i(jl, jkl) = 1.0 - zclear(jl)
          zscat(jl) = zss0(jl)
       ELSE IF (novlp==2) THEN
          ! * maximum
          zscat(jl) = max(zss0(jl), zscat(jl))
          zc0i(jl, jkl) = zscat(jl)
       ELSE IF (novlp==3) THEN
          ! * random
          zclear(jl) = zclear(jl)*(1.0-zss0(jl))
          zscat(jl) = 1.0 - zclear(jl)
          zc0i(jl, jkl) = zscat(jl)
       END IF
    END DO

    DO jk = 2, kflev
       jkl = kflev + 1 - jk
       jklp1 = jkl + 1
       DO jl = 1, kdlon
          zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
          zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
          zr21(jl) = exp(-zcorae)
          zss0(jl) = 1. - zr21(jl)

          IF (novlp==1) THEN
             ! * maximum-random
             zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
                  (1.0-min(zscat(jl),1.-zepsec))
             zc0i(jl, jkl) = 1.0 - zclear(jl)
             zscat(jl) = zss0(jl)
          ELSE IF (novlp==2) THEN
             ! * maximum
             zscat(jl) = max(zss0(jl), zscat(jl))
             zc0i(jl, jkl) = zscat(jl)
          ELSE IF (novlp==3) THEN
             ! * random
             zclear(jl) = zclear(jl)*(1.0-zss0(jl))
             zscat(jl) = 1.0 - zclear(jl)
             zc0i(jl, jkl) = zscat(jl)
          END IF
       END DO
    END DO

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

    ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
    ! -----------------------------------------------


    DO jl = 1, kdlon
       pray1(jl, kflev+1) = 0.
       pray2(jl, kflev+1) = 0.
       prefz(jl, 2, 1) = palbp(jl, knu)
       prefz(jl, 1, 1) = palbp(jl, knu)
       ptra1(jl, kflev+1) = 1.
       ptra2(jl, kflev+1) = 1.
    END DO

    DO jk = 2, kflev + 1
       jkm1 = jk - 1
       DO jl = 1, kdlon


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

          ! *         3.1  EQUIVALENT ZENITH ANGLE
          ! -----------------------


          zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66
          prmu0(jl, jk) = 1./zmue


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

          ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
          ! ----------------------------------------------------


          zgap = pcgaz(jl, jkm1)
          zbmu0 = 0.5 - 0.75*zgap/zmue
          zww = ppizaz(jl, jkm1)
          zto = ptauaz(jl, jkm1)
          zden = 1. + (1.-zww+zbmu0*zww)*zto*zmue + (1-zww)*(1.-zww+2.*zbmu0*zww) &
               *zto*zto*zmue*zmue
          pray1(jl, jkm1) = zbmu0*zww*zto*zmue/zden
          ptra1(jl, jkm1) = 1./zden

          zmu1 = 0.5
          zbmu1 = 0.5 - 0.75*zgap*zmu1
          zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &
               )*zto*zto/zmu1/zmu1
          pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1
          ptra2(jl, jkm1) = 1./zden1


          prefz(jl, 1, jk) = (pray1(jl,jkm1)+prefz(jl,1,jkm1)*ptra1(jl,jkm1)* &
               ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1,jkm1)))

          ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
               jkm1)))

          prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)*ptra1(jl,jkm1)* &
               ptra2(jl,jkm1))

          ztr(jl, 2, jkm1) = ptra1(jl, jkm1)

       END DO
    END DO
    DO jl = 1, kdlon
       zmue = (1.-zc0i(jl,1))*psec(jl) + zc0i(jl, 1)*1.66
       prmu0(jl, 1) = 1./zmue
    END DO


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

    ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
    ! -------------------------------------------------


    IF (knu==1) THEN
       jaj = 2
       DO jl = 1, kdlon
          prj(jl, jaj, kflev+1) = 1.
          prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
       END DO

       DO jk = 1, kflev
          jkl = kflev + 1 - jk
          jklp1 = jkl + 1
          DO jl = 1, kdlon
             zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)
             prj(jl, jaj, jkl) = zre11
             prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)
          END DO
       END DO

    ELSE

       DO jaj = 1, 2
          DO jl = 1, kdlon
             prj(jl, jaj, kflev+1) = 1.
             prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
          END DO

          DO jk = 1, kflev
             jkl = kflev + 1 - jk
             jklp1 = jkl + 1
             DO jl = 1, kdlon
                zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
                prj(jl, jaj, jkl) = zre11
                prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
             END DO
          END DO
       END DO

    END IF

  END SUBROUTINE swclr

end module swclr_m
1	module swclr_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
8	prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
9	ptra1, ptra2)
10	USE dimens_m
11	USE dimphy
12	USE raddim
13	USE radepsi
14	USE radopt
15
16	! ------------------------------------------------------------------
17	! PURPOSE.
18	! --------
19	! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
20	! CLEAR-SKY COLUMN
21
22	! REFERENCE.
23	! ----------
24
25	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
26	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
27
28	! AUTHOR.
29	! -------
30	! JEAN-JACQUES MORCRETTE ECMWF
31
32	! MODIFICATIONS.
33	! --------------
34	! ORIGINAL : 94-11-15
35	! ------------------------------------------------------------------
36	! * ARGUMENTS:
37
38	INTEGER knu
39	! -OB
40	DOUBLE PRECISION flag_aer
41	DOUBLE PRECISION tauae(kdlon, kflev, 2)
42	DOUBLE PRECISION pizae(kdlon, kflev, 2)
43	DOUBLE PRECISION cgae(kdlon, kflev, 2)
44	DOUBLE PRECISION palbp(kdlon, 2)
45	DOUBLE PRECISION pdsig(kdlon, kflev)
46	DOUBLE PRECISION prayl(kdlon)
47	DOUBLE PRECISION psec(kdlon)
48
49	DOUBLE PRECISION pcgaz(kdlon, kflev)
50	DOUBLE PRECISION ppizaz(kdlon, kflev)
51	DOUBLE PRECISION pray1(kdlon, kflev+1)
52	DOUBLE PRECISION pray2(kdlon, kflev+1)
53	DOUBLE PRECISION prefz(kdlon, 2, kflev+1)
54	DOUBLE PRECISION prj(kdlon, 6, kflev+1)
55	DOUBLE PRECISION prk(kdlon, 6, kflev+1)
56	DOUBLE PRECISION prmu0(kdlon, kflev+1)
57	DOUBLE PRECISION ptauaz(kdlon, kflev)
58	DOUBLE PRECISION ptra1(kdlon, kflev+1)
59	DOUBLE PRECISION ptra2(kdlon, kflev+1)
60
61	! * LOCAL VARIABLES:
62
63	DOUBLE PRECISION zc0i(kdlon, kflev+1)
64	DOUBLE PRECISION zclear(kdlon)
65	DOUBLE PRECISION zr21(kdlon)
66	DOUBLE PRECISION zss0(kdlon)
67	DOUBLE PRECISION zscat(kdlon)
68	DOUBLE PRECISION ztr(kdlon, 2, kflev+1)
69
70	INTEGER jl, jk, ja, jkl, jklp1, jaj, jkm1
71	DOUBLE PRECISION ztray, zgar, zratio, zff, zfacoa, zcorae
72	DOUBLE PRECISION zmue, zgap, zww, zto, zden, zmu1, zden1
73	DOUBLE PRECISION zbmu0, zbmu1, zre11
74
75	! ------------------------------------------------------------------
76
77	! * 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
78	! --------------------------------------------
79
80
81	DO jk = 1, kflev + 1
82	DO ja = 1, 6
83	DO jl = 1, kdlon
84	prj(jl, ja, jk) = 0.
85	prk(jl, ja, jk) = 0.
86	END DO
87	END DO
88	END DO
89
90	DO jk = 1, kflev
91	DO jl = 1, kdlon
92	ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
93	ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
94	pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
95	END DO
96
97	IF (flag_aer>0) THEN
98	! -OB
99	DO jl = 1, kdlon
100	! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
101	! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
102	ztray = prayl(jl)*pdsig(jl, jk)
103	zratio = ztray/(ztray+ptauaz(jl,jk))
104	zgar = pcgaz(jl, jk)
105	zff = zgar*zgar
106	ptauaz(jl, jk) = ztray + ptauaz(jl, jk)(1.-ppizaz(jl,jk)zff)
107	pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)
108	ppizaz(jl, jk) = zratio + (1.-zratio)ppizaz(jl, jk)(1.-zff)/(1.- &
109	ppizaz(jl,jk)*zff)
110	END DO
111	ELSE
112	DO jl = 1, kdlon
113	ztray = prayl(jl)*pdsig(jl, jk)
114	ptauaz(jl, jk) = ztray
115	pcgaz(jl, jk) = 0.
116	ppizaz(jl, jk) = 1. - repsct
117	END DO
118	END IF ! check flag_aer
119	END DO
120
121	! ------------------------------------------------------------------
122
123	! * 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
124	! ----------------------------------------------
125
126
127	DO jl = 1, kdlon
128	zc0i(jl, kflev+1) = 0.
129	zclear(jl) = 1.
130	zscat(jl) = 0.
131	END DO
132
133	jk = 1
134	jkl = kflev + 1 - jk
135	jklp1 = jkl + 1
136	DO jl = 1, kdlon
137	zfacoa = 1. - ppizaz(jl, jkl)pcgaz(jl, jkl)pcgaz(jl, jkl)
138	zcorae = zfacoaptauaz(jl, jkl)psec(jl)
139	zr21(jl) = exp(-zcorae)
140	zss0(jl) = 1. - zr21(jl)
141
142	IF (novlp==1) THEN
143	! * maximum-random
144	zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
145	(1.0-min(zscat(jl),1.-zepsec))
146	zc0i(jl, jkl) = 1.0 - zclear(jl)
147	zscat(jl) = zss0(jl)
148	ELSE IF (novlp==2) THEN
149	! * maximum
150	zscat(jl) = max(zss0(jl), zscat(jl))
151	zc0i(jl, jkl) = zscat(jl)
152	ELSE IF (novlp==3) THEN
153	! * random
154	zclear(jl) = zclear(jl)*(1.0-zss0(jl))
155	zscat(jl) = 1.0 - zclear(jl)
156	zc0i(jl, jkl) = zscat(jl)
157	END IF
158	END DO
159
160	DO jk = 2, kflev
161	jkl = kflev + 1 - jk
162	jklp1 = jkl + 1
163	DO jl = 1, kdlon
164	zfacoa = 1. - ppizaz(jl, jkl)pcgaz(jl, jkl)pcgaz(jl, jkl)
165	zcorae = zfacoaptauaz(jl, jkl)psec(jl)
166	zr21(jl) = exp(-zcorae)
167	zss0(jl) = 1. - zr21(jl)
168
169	IF (novlp==1) THEN
170	! * maximum-random
171	zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
172	(1.0-min(zscat(jl),1.-zepsec))
173	zc0i(jl, jkl) = 1.0 - zclear(jl)
174	zscat(jl) = zss0(jl)
175	ELSE IF (novlp==2) THEN
176	! * maximum
177	zscat(jl) = max(zss0(jl), zscat(jl))
178	zc0i(jl, jkl) = zscat(jl)
179	ELSE IF (novlp==3) THEN
180	! * random
181	zclear(jl) = zclear(jl)*(1.0-zss0(jl))
182	zscat(jl) = 1.0 - zclear(jl)
183	zc0i(jl, jkl) = zscat(jl)
184	END IF
185	END DO
186	END DO
187
188	! ------------------------------------------------------------------
189
190	! * 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
191	! -----------------------------------------------
192
193
194	DO jl = 1, kdlon
195	pray1(jl, kflev+1) = 0.
196	pray2(jl, kflev+1) = 0.
197	prefz(jl, 2, 1) = palbp(jl, knu)
198	prefz(jl, 1, 1) = palbp(jl, knu)
199	ptra1(jl, kflev+1) = 1.
200	ptra2(jl, kflev+1) = 1.
201	END DO
202
203	DO jk = 2, kflev + 1
204	jkm1 = jk - 1
205	DO jl = 1, kdlon
206
207
208	! ------------------------------------------------------------------
209
210	! * 3.1 EQUIVALENT ZENITH ANGLE
211	! -----------------------
212
213
214	zmue = (1.-zc0i(jl,jk))psec(jl) + zc0i(jl, jk)1.66
215	prmu0(jl, jk) = 1./zmue
216
217
218	! ------------------------------------------------------------------
219
220	! * 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
221	! ----------------------------------------------------
222
223
224	zgap = pcgaz(jl, jkm1)
225	zbmu0 = 0.5 - 0.75*zgap/zmue
226	zww = ppizaz(jl, jkm1)
227	zto = ptauaz(jl, jkm1)
228	zden = 1. + (1.-zww+zbmu0zww)ztozmue + (1-zww)(1.-zww+2.zbmu0zww) &
229	ztoztozmuezmue
230	pray1(jl, jkm1) = zbmu0zwwzto*zmue/zden
231	ptra1(jl, jkm1) = 1./zden
232
233	zmu1 = 0.5
234	zbmu1 = 0.5 - 0.75zgapzmu1
235	zden1 = 1. + (1.-zww+zbmu1zww)zto/zmu1 + (1-zww)(1.-zww+2.zbmu1*zww &
236	)ztozto/zmu1/zmu1
237	pray2(jl, jkm1) = zbmu1zwwzto/zmu1/zden1
238	ptra2(jl, jkm1) = 1./zden1
239
240
241
242	prefz(jl, 1, jk) = (pray1(jl,jkm1)+prefz(jl,1,jkm1)ptra1(jl,jkm1) &
243	ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1,jkm1)))
244
245	ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
246	jkm1)))
247
248	prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)ptra1(jl,jkm1) &
249	ptra2(jl,jkm1))
250
251	ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
252
253	END DO
254	END DO
255	DO jl = 1, kdlon
256	zmue = (1.-zc0i(jl,1))psec(jl) + zc0i(jl, 1)1.66
257	prmu0(jl, 1) = 1./zmue
258	END DO
259
260
261	! ------------------------------------------------------------------
262
263	! * 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
264	! -------------------------------------------------
265
266
267	IF (knu==1) THEN
268	jaj = 2
269	DO jl = 1, kdlon
270	prj(jl, jaj, kflev+1) = 1.
271	prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
272	END DO
273
274	DO jk = 1, kflev
275	jkl = kflev + 1 - jk
276	jklp1 = jkl + 1
277	DO jl = 1, kdlon
278	zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)
279	prj(jl, jaj, jkl) = zre11
280	prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)
281	END DO
282	END DO
283
284	ELSE
285
286	DO jaj = 1, 2
287	DO jl = 1, kdlon
288	prj(jl, jaj, kflev+1) = 1.
289	prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
290	END DO
291
292	DO jk = 1, kflev
293	jkl = kflev + 1 - jk
294	jklp1 = jkl + 1
295	DO jl = 1, kdlon
296	zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
297	prj(jl, jaj, jkl) = zre11
298	prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
299	END DO
300	END DO
301	END DO
302
303	END IF
304
305	END SUBROUTINE swclr
306
307	end module swclr_m