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	guez	178	module swclr_m
2
3	guez	81	IMPLICIT NONE
4
5	guez	178	contains
6	guez	81
7	guez	208	SUBROUTINE swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, prayl, &
8			psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
9	guez	178	ptra1, ptra2)
10	guez	208
11			USE raddim, only: kdlon, kflev
12			USE radepsi, only: repsct, zepsec
13			USE radopt, only: novlp
14	guez	81
15	guez	178	! ------------------------------------------------------------------
16			! PURPOSE.
17			! --------
18			! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
19			! CLEAR-SKY COLUMN
20	guez	81
21	guez	178	! REFERENCE.
22			! ----------
23	guez	81
24	guez	178	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
25			! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
26	guez	81
27	guez	178	! AUTHOR.
28			! -------
29			! JEAN-JACQUES MORCRETTE ECMWF
30	guez	81
31	guez	178	! MODIFICATIONS.
32			! --------------
33			! ORIGINAL : 94-11-15
34			! ------------------------------------------------------------------
35			! * ARGUMENTS:
36	guez	81
37	guez	178	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	guez	81
48	guez	178	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	guez	81
60	guez	178	! * LOCAL VARIABLES:
61	guez	81
62	guez	178	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	guez	81
69	guez	178	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	guez	81
74	guez	178	! ------------------------------------------------------------------
75	guez	81
76	guez	178	! * 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
77			! --------------------------------------------
78	guez	81
79	guez	178
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	guez	81	END DO
88
89	guez	178	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	guez	81
96	guez	178	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	guez	81
120	guez	178	! ------------------------------------------------------------------
121	guez	81
122	guez	178	! * 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
123			! ----------------------------------------------
124	guez	81
125
126	guez	178	DO jl = 1, kdlon
127			zc0i(jl, kflev+1) = 0.
128			zclear(jl) = 1.
129			zscat(jl) = 0.
130			END DO
131	guez	81
132	guez	178	jk = 1
133	guez	81	jkl = kflev + 1 - jk
134			jklp1 = jkl + 1
135			DO jl = 1, kdlon
136	guez	178	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	guez	81
141	guez	178	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	guez	81	END DO
158
159	guez	178	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	guez	81
168	guez	178	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	guez	81
187	guez	178	! ------------------------------------------------------------------
188	guez	81
189	guez	178	! * 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
190			! -----------------------------------------------
191	guez	81
192	guez	178
193	guez	81	DO jl = 1, kdlon
194	guez	178	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	guez	81
202	guez	178	DO jk = 2, kflev + 1
203			jkm1 = jk - 1
204			DO jl = 1, kdlon
205	guez	81
206
207	guez	178	! ------------------------------------------------------------------
208	guez	81
209	guez	178	! * 3.1 EQUIVALENT ZENITH ANGLE
210			! -----------------------
211	guez	81
212
213	guez	178	zmue = (1.-zc0i(jl,jk))psec(jl) + zc0i(jl, jk)1.66
214			prmu0(jl, jk) = 1./zmue
215	guez	81
216
217	guez	178	! ------------------------------------------------------------------
218	guez	81
219	guez	178	! * 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
220			! ----------------------------------------------------
221	guez	81
222
223	guez	178	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	guez	81
232	guez	178	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	guez	81
239
240
241	guez	178	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	guez	81
244	guez	178	ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
245			jkm1)))
246	guez	81
247	guez	178	prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)ptra1(jl,jkm1) &
248			ptra2(jl,jkm1))
249	guez	81
250	guez	178	ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
251
252			END DO
253	guez	81	END DO
254	guez	178	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	guez	81
259
260	guez	178	! ------------------------------------------------------------------
261	guez	81
262	guez	178	! * 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
263			! -------------------------------------------------
264	guez	81
265
266	guez	178	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	guez	81
273	guez	178	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	guez	81
283	guez	178	ELSE
284	guez	81
285	guez	178	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	guez	81
291	guez	178	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	guez	81
302	guez	178	END IF
303	guez	81
304	guez	178	END SUBROUTINE swclr
305	guez	81
306	guez	178	end module swclr_m