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 raddim, only: kdlon, kflev
    USE radepsi, only: repsct, zepsec
    USE radopt, only: novlp

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