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	guez	178	module swclr_m
2
3	guez	81	IMPLICIT NONE
4
5	guez	178	contains
6	guez	81
7	guez	178	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	guez	81
16	guez	178	! ------------------------------------------------------------------
17			! PURPOSE.
18			! --------
19			! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
20			! CLEAR-SKY COLUMN
21	guez	81
22	guez	178	! REFERENCE.
23			! ----------
24	guez	81
25	guez	178	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
26			! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
27	guez	81
28	guez	178	! AUTHOR.
29			! -------
30			! JEAN-JACQUES MORCRETTE ECMWF
31	guez	81
32	guez	178	! MODIFICATIONS.
33			! --------------
34			! ORIGINAL : 94-11-15
35			! ------------------------------------------------------------------
36			! * ARGUMENTS:
37	guez	81
38	guez	178	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	guez	81
49	guez	178	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	guez	81
61	guez	178	! * LOCAL VARIABLES:
62	guez	81
63	guez	178	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	guez	81
70	guez	178	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	guez	81
75	guez	178	! ------------------------------------------------------------------
76	guez	81
77	guez	178	! * 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
78			! --------------------------------------------
79	guez	81
80	guez	178
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	guez	81	END DO
89
90	guez	178	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	guez	81
97	guez	178	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	guez	81
121	guez	178	! ------------------------------------------------------------------
122	guez	81
123	guez	178	! * 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
124			! ----------------------------------------------
125	guez	81
126
127	guez	178	DO jl = 1, kdlon
128			zc0i(jl, kflev+1) = 0.
129			zclear(jl) = 1.
130			zscat(jl) = 0.
131			END DO
132	guez	81
133	guez	178	jk = 1
134	guez	81	jkl = kflev + 1 - jk
135			jklp1 = jkl + 1
136			DO jl = 1, kdlon
137	guez	178	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	guez	81
142	guez	178	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	guez	81	END DO
159
160	guez	178	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	guez	81
169	guez	178	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	guez	81
188	guez	178	! ------------------------------------------------------------------
189	guez	81
190	guez	178	! * 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
191			! -----------------------------------------------
192	guez	81
193	guez	178
194	guez	81	DO jl = 1, kdlon
195	guez	178	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	guez	81
203	guez	178	DO jk = 2, kflev + 1
204			jkm1 = jk - 1
205			DO jl = 1, kdlon
206	guez	81
207
208	guez	178	! ------------------------------------------------------------------
209	guez	81
210	guez	178	! * 3.1 EQUIVALENT ZENITH ANGLE
211			! -----------------------
212	guez	81
213
214	guez	178	zmue = (1.-zc0i(jl,jk))psec(jl) + zc0i(jl, jk)1.66
215			prmu0(jl, jk) = 1./zmue
216	guez	81
217
218	guez	178	! ------------------------------------------------------------------
219	guez	81
220	guez	178	! * 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
221			! ----------------------------------------------------
222	guez	81
223
224	guez	178	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	guez	81
233	guez	178	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	guez	81
240
241
242	guez	178	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	guez	81
245	guez	178	ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
246			jkm1)))
247	guez	81
248	guez	178	prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)ptra1(jl,jkm1) &
249			ptra2(jl,jkm1))
250	guez	81
251	guez	178	ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
252
253			END DO
254	guez	81	END DO
255	guez	178	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	guez	81
260
261	guez	178	! ------------------------------------------------------------------
262	guez	81
263	guez	178	! * 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
264			! -------------------------------------------------
265	guez	81
266
267	guez	178	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	guez	81
274	guez	178	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	guez	81
284	guez	178	ELSE
285	guez	81
286	guez	178	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	guez	81
292	guez	178	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	guez	81
303	guez	178	END IF
304	guez	81
305	guez	178	END SUBROUTINE swclr
306	guez	81
307	guez	178	end module swclr_m