phylmd/Radlwsw/swclr.f

SUBROUTINE swclr(knu, paer, 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
  IMPLICIT NONE

  ! ------------------------------------------------------------------
  ! 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 paer(kdlon, kflev, 5)
  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 zcle0(kdlon, kflev)
  DOUBLE PRECISION zclear(kdlon)
  DOUBLE PRECISION zr21(kdlon)
  DOUBLE PRECISION zr23(kdlon)
  DOUBLE PRECISION zss0(kdlon)
  DOUBLE PRECISION zscat(kdlon)
  DOUBLE PRECISION ztr(kdlon, 2, kflev+1)

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

  ! * Prescribed Data for Aerosols:

  DOUBLE PRECISION taua(2, 5), rpiza(2, 5), rcga(2, 5)
  SAVE taua, rpiza, rcga
  DATA ((taua(in,ja),ja=1,5), in=1, 2)/.730719, .912819, .725059, .745405, &
    .682188, .730719, .912819, .725059, .745405, .682188/
  DATA ((rpiza(in,ja),ja=1,5), in=1, 2)/.872212, .982545, .623143, .944887, &
    .997975, .872212, .982545, .623143, .944887, .997975/
  DATA ((rcga(in,ja),ja=1,5), in=1, 2)/.647596, .739002, .580845, .662657, &
    .624246, .647596, .739002, .580845, .662657, .624246/
  ! ------------------------------------------------------------------

  ! *         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
    ! -OB
    ! DO 104 JL = 1, KDLON
    ! PCGAZ(JL,JK) = 0.
    ! PPIZAZ(JL,JK) =  0.
    ! PTAUAZ(JL,JK) = 0.
    ! 104  CONTINUE
    ! -OB
    ! DO 106 JAE=1,5
    ! DO 105 JL = 1, KDLON
    ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
    ! S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
    ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
    ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
    ! PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)
    ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
    ! 105  CONTINUE
    ! 106  CONTINUE
    ! -OB
    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
    ! 107  CONTINUE
    ! PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)
    ! $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)
    ! 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)

  END DO

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

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


  DO jl = 1, kdlon
    zr23(jl) = 0.
    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)
    zcle0(jl, jkl) = zss0(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)
      zcle0(jl, jkl) = zss0(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

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

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