/[lmdze]/trunk/Sources/phylmd/Radlwsw/swclr.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/swclr.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/phylmd/Radlwsw/swclr.f revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/Sources/phylmd/Radlwsw/swclr.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 1  Line 1 
1        SUBROUTINE SWCLR  ( KNU  module swclr_m
2       S  , PAER  , flag_aer, tauae, pizae, cgae  
3       S  , PALBP , PDSIG , PRAYL , PSEC    IMPLICIT NONE
4       S  , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ    
5       S  , PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2                   )  contains
6        use dimens_m  
7        use dimphy    SUBROUTINE swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
8        use raddim         prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
9        use radepsi         ptra1, ptra2)
10        use radopt      USE dimens_m
11        IMPLICIT none      USE dimphy
12  C      USE raddim
13  C     ------------------------------------------------------------------      USE radepsi
14  C     PURPOSE.      USE radopt
15  C     --------  
16  C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF      ! ------------------------------------------------------------------
17  C     CLEAR-SKY COLUMN      ! PURPOSE.
18  C      ! --------
19  C     REFERENCE.      ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
20  C     ----------      ! CLEAR-SKY COLUMN
21  C  
22  C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT      ! REFERENCE.
23  C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)      ! ----------
24  C  
25  C     AUTHOR.      ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
26  C     -------      ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
27  C        JEAN-JACQUES MORCRETTE  *ECMWF*  
28  C      ! AUTHOR.
29  C     MODIFICATIONS.      ! -------
30  C     --------------      ! JEAN-JACQUES MORCRETTE  *ECMWF*
31  C        ORIGINAL : 94-11-15  
32  C     ------------------------------------------------------------------      ! MODIFICATIONS.
33  C* ARGUMENTS:      ! --------------
34  C      ! ORIGINAL : 94-11-15
35        INTEGER KNU      ! ------------------------------------------------------------------
36  c-OB      ! * ARGUMENTS:
37        double precision flag_aer  
38        double precision tauae(kdlon,kflev,2)      INTEGER knu
39        double precision pizae(kdlon,kflev,2)      ! -OB
40        double precision cgae(kdlon,kflev,2)      DOUBLE PRECISION flag_aer
41        DOUBLE PRECISION PAER(KDLON,KFLEV,5)      DOUBLE PRECISION tauae(kdlon, kflev, 2)
42        DOUBLE PRECISION PALBP(KDLON,2)      DOUBLE PRECISION pizae(kdlon, kflev, 2)
43        DOUBLE PRECISION PDSIG(KDLON,KFLEV)      DOUBLE PRECISION cgae(kdlon, kflev, 2)
44        DOUBLE PRECISION PRAYL(KDLON)      DOUBLE PRECISION palbp(kdlon, 2)
45        DOUBLE PRECISION PSEC(KDLON)      DOUBLE PRECISION pdsig(kdlon, kflev)
46  C      DOUBLE PRECISION prayl(kdlon)
47        DOUBLE PRECISION PCGAZ(KDLON,KFLEV)          DOUBLE PRECISION psec(kdlon)
48        DOUBLE PRECISION PPIZAZ(KDLON,KFLEV)  
49        DOUBLE PRECISION PRAY1(KDLON,KFLEV+1)      DOUBLE PRECISION pcgaz(kdlon, kflev)
50        DOUBLE PRECISION PRAY2(KDLON,KFLEV+1)      DOUBLE PRECISION ppizaz(kdlon, kflev)
51        DOUBLE PRECISION PREFZ(KDLON,2,KFLEV+1)      DOUBLE PRECISION pray1(kdlon, kflev+1)
52        DOUBLE PRECISION PRJ(KDLON,6,KFLEV+1)      DOUBLE PRECISION pray2(kdlon, kflev+1)
53        DOUBLE PRECISION PRK(KDLON,6,KFLEV+1)      DOUBLE PRECISION prefz(kdlon, 2, kflev+1)
54        DOUBLE PRECISION PRMU0(KDLON,KFLEV+1)      DOUBLE PRECISION prj(kdlon, 6, kflev+1)
55        DOUBLE PRECISION PTAUAZ(KDLON,KFLEV)      DOUBLE PRECISION prk(kdlon, 6, kflev+1)
56        DOUBLE PRECISION PTRA1(KDLON,KFLEV+1)      DOUBLE PRECISION prmu0(kdlon, kflev+1)
57        DOUBLE PRECISION PTRA2(KDLON,KFLEV+1)      DOUBLE PRECISION ptauaz(kdlon, kflev)
58  C      DOUBLE PRECISION ptra1(kdlon, kflev+1)
59  C* LOCAL VARIABLES:      DOUBLE PRECISION ptra2(kdlon, kflev+1)
60  C  
61        DOUBLE PRECISION ZC0I(KDLON,KFLEV+1)            ! * LOCAL VARIABLES:
62        DOUBLE PRECISION ZCLE0(KDLON,KFLEV)  
63        DOUBLE PRECISION ZCLEAR(KDLON)      DOUBLE PRECISION zc0i(kdlon, kflev+1)
64        DOUBLE PRECISION ZR21(KDLON)      DOUBLE PRECISION zclear(kdlon)
65        DOUBLE PRECISION ZR23(KDLON)      DOUBLE PRECISION zr21(kdlon)
66        DOUBLE PRECISION ZSS0(KDLON)      DOUBLE PRECISION zss0(kdlon)
67        DOUBLE PRECISION ZSCAT(KDLON)      DOUBLE PRECISION zscat(kdlon)
68        DOUBLE PRECISION ZTR(KDLON,2,KFLEV+1)      DOUBLE PRECISION ztr(kdlon, 2, kflev+1)
69  C  
70        INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in      INTEGER jl, jk, ja, jkl, jklp1, jaj, jkm1
71        DOUBLE PRECISION ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE      DOUBLE PRECISION ztray, zgar, zratio, zff, zfacoa, zcorae
72        DOUBLE PRECISION ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1      DOUBLE PRECISION zmue, zgap, zww, zto, zden, zmu1, zden1
73        DOUBLE PRECISION ZBMU0, ZBMU1, ZRE11      DOUBLE PRECISION zbmu0, zbmu1, zre11
74  C  
75  C* Prescribed Data for Aerosols:      ! ------------------------------------------------------------------
76  C  
77        DOUBLE PRECISION TAUA(2,5), RPIZA(2,5), RCGA(2,5)      ! *         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
78        SAVE TAUA, RPIZA, RCGA      ! --------------------------------------------
79        DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) /  
80       S .730719, .912819, .725059, .745405, .682188 ,  
81       S .730719, .912819, .725059, .745405, .682188 /      DO jk = 1, kflev + 1
82        DATA ((RPIZA(IN,JA),JA=1,5),IN=1,2) /         DO ja = 1, 6
83       S .872212, .982545, .623143, .944887, .997975 ,            DO jl = 1, kdlon
84       S .872212, .982545, .623143, .944887, .997975 /               prj(jl, ja, jk) = 0.
85        DATA ((RCGA (IN,JA),JA=1,5),IN=1,2) /               prk(jl, ja, jk) = 0.
86       S .647596, .739002, .580845, .662657, .624246 ,            END DO
87       S .647596, .739002, .580845, .662657, .624246 /         END DO
88  C     ------------------------------------------------------------------      END DO
89  C  
90  C*         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH      DO jk = 1, kflev
91  C                --------------------------------------------         DO jl = 1, kdlon
92  C            ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
93   100  CONTINUE            ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
94  C            pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
95        DO 103 JK = 1 , KFLEV+1         END DO
96        DO 102 JA = 1 , 6  
97        DO 101 JL = 1, KDLON         IF (flag_aer>0) THEN
98        PRJ(JL,JA,JK) = 0.            ! -OB
99        PRK(JL,JA,JK) = 0.            DO jl = 1, kdlon
100   101  CONTINUE               ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
101   102  CONTINUE               ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
102   103  CONTINUE               ztray = prayl(jl)*pdsig(jl, jk)
103  C               zratio = ztray/(ztray+ptauaz(jl,jk))
104        DO 108 JK = 1 , KFLEV               zgar = pcgaz(jl, jk)
105  c-OB               zff = zgar*zgar
106  c      DO 104 JL = 1, KDLON               ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)
107  c      PCGAZ(JL,JK) = 0.               pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)
108  c      PPIZAZ(JL,JK) =  0.               ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &
109  c      PTAUAZ(JL,JK) = 0.                    ppizaz(jl,jk)*zff)
110  c 104  CONTINUE            END DO
111  c-OB         ELSE
112  c      DO 106 JAE=1,5            DO jl = 1, kdlon
113  c      DO 105 JL = 1, KDLON               ztray = prayl(jl)*pdsig(jl, jk)
114  c      PTAUAZ(JL,JK)=PTAUAZ(JL,JK)               ptauaz(jl, jk) = ztray
115  c     S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)               pcgaz(jl, jk) = 0.
116  c      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)               ppizaz(jl, jk) = 1. - repsct
117  c     S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)            END DO
118  c      PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)         END IF ! check flag_aer
119  c     S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)      END DO
120  c 105  CONTINUE  
121  c 106  CONTINUE      ! ------------------------------------------------------------------
122  c-OB  
123        DO 105 JL = 1, KDLON      ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
124        PTAUAZ(JL,JK)=flag_aer * tauae(JL,JK,KNU)      ! ----------------------------------------------
125        PPIZAZ(JL,JK)=flag_aer * pizae(JL,JK,KNU)  
126        PCGAZ (JL,JK)=flag_aer * cgae(JL,JK,KNU)  
127   105  CONTINUE      DO jl = 1, kdlon
128  C         zc0i(jl, kflev+1) = 0.
129        IF (flag_aer.GT.0) THEN         zclear(jl) = 1.
130  c-OB         zscat(jl) = 0.
131        DO 107 JL = 1, KDLON      END DO
132  c         PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)  
133  c         PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)      jk = 1
134           ZTRAY = PRAYL(JL) * PDSIG(JL,JK)      jkl = kflev + 1 - jk
135           ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))      jklp1 = jkl + 1
136           ZGAR = PCGAZ(JL,JK)      DO jl = 1, kdlon
137           ZFF = ZGAR * ZGAR         zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
138           PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.-PPIZAZ(JL,JK)*ZFF)         zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
139           PCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)         zr21(jl) = exp(-zcorae)
140           PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*PPIZAZ(JL,JK)*(1.-ZFF)         zss0(jl) = 1. - zr21(jl)
141       S                       / (1. - PPIZAZ(JL,JK) * ZFF)  
142   107  CONTINUE         IF (novlp==1) THEN
143        ELSE            ! * maximum-random
144        DO JL = 1, KDLON            zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
145           ZTRAY = PRAYL(JL) * PDSIG(JL,JK)                 (1.0-min(zscat(jl),1.-zepsec))
146           PTAUAZ(JL,JK) = ZTRAY            zc0i(jl, jkl) = 1.0 - zclear(jl)
147           PCGAZ(JL,JK) = 0.            zscat(jl) = zss0(jl)
148           PPIZAZ(JL,JK) = 1.-REPSCT         ELSE IF (novlp==2) THEN
149        END DO            ! * maximum
150        END IF   ! check flag_aer            zscat(jl) = max(zss0(jl), zscat(jl))
151  c     107  CONTINUE            zc0i(jl, jkl) = zscat(jl)
152  c      PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)         ELSE IF (novlp==3) THEN
153  c     $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)            ! * random
154  c 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)            zclear(jl) = zclear(jl)*(1.0-zss0(jl))
155  C            zscat(jl) = 1.0 - zclear(jl)
156   108  CONTINUE            zc0i(jl, jkl) = zscat(jl)
157  C         END IF
158  C     ------------------------------------------------------------------      END DO
159  C  
160  C*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL      DO jk = 2, kflev
161  C                ----------------------------------------------         jkl = kflev + 1 - jk
162  C         jklp1 = jkl + 1
163   200  CONTINUE         DO jl = 1, kdlon
164  C            zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
165        DO 201 JL = 1, KDLON            zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
166        ZR23(JL) = 0.            zr21(jl) = exp(-zcorae)
167        ZC0I(JL,KFLEV+1) = 0.            zss0(jl) = 1. - zr21(jl)
168        ZCLEAR(JL) = 1.  
169        ZSCAT(JL) = 0.            IF (novlp==1) THEN
170   201  CONTINUE               ! * maximum-random
171  C               zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
172        JK = 1                    (1.0-min(zscat(jl),1.-zepsec))
173        JKL = KFLEV+1 - JK               zc0i(jl, jkl) = 1.0 - zclear(jl)
174        JKLP1 = JKL + 1               zscat(jl) = zss0(jl)
175        DO 202 JL = 1, KDLON            ELSE IF (novlp==2) THEN
176        ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)               ! * maximum
177        ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)               zscat(jl) = max(zss0(jl), zscat(jl))
178        ZR21(JL) = EXP(-ZCORAE   )               zc0i(jl, jkl) = zscat(jl)
179        ZSS0(JL) = 1.-ZR21(JL)            ELSE IF (novlp==3) THEN
180        ZCLE0(JL,JKL) = ZSS0(JL)               ! * random
181  C               zclear(jl) = zclear(jl)*(1.0-zss0(jl))
182        IF (NOVLP.EQ.1) THEN               zscat(jl) = 1.0 - zclear(jl)
183  c* maximum-random               zc0i(jl, jkl) = zscat(jl)
184           ZCLEAR(JL) = ZCLEAR(JL)            END IF
185       S                  *(1.0-MAX(ZSS0(JL),ZSCAT(JL)))         END DO
186       S                  /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC))      END DO
187           ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL)  
188           ZSCAT(JL) = ZSS0(JL)      ! ------------------------------------------------------------------
189        ELSE IF (NOVLP.EQ.2) THEN  
190  C* maximum      ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
191           ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )      ! -----------------------------------------------
192           ZC0I(JL,JKL) = ZSCAT(JL)  
193        ELSE IF (NOVLP.EQ.3) THEN  
194  c* random      DO jl = 1, kdlon
195           ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL))         pray1(jl, kflev+1) = 0.
196           ZSCAT(JL) = 1.0 - ZCLEAR(JL)         pray2(jl, kflev+1) = 0.
197           ZC0I(JL,JKL) = ZSCAT(JL)         prefz(jl, 2, 1) = palbp(jl, knu)
198        END IF         prefz(jl, 1, 1) = palbp(jl, knu)
199   202  CONTINUE         ptra1(jl, kflev+1) = 1.
200  C         ptra2(jl, kflev+1) = 1.
201        DO 205 JK = 2 , KFLEV      END DO
202        JKL = KFLEV+1 - JK  
203        JKLP1 = JKL + 1      DO jk = 2, kflev + 1
204        DO 204 JL = 1, KDLON         jkm1 = jk - 1
205        ZFACOA = 1. - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)         DO jl = 1, kdlon
206        ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)  
207        ZR21(JL) = EXP(-ZCORAE   )  
208        ZSS0(JL) = 1.-ZR21(JL)            ! ------------------------------------------------------------------
209        ZCLE0(JL,JKL) = ZSS0(JL)  
210  c                ! *         3.1  EQUIVALENT ZENITH ANGLE
211        IF (NOVLP.EQ.1) THEN            ! -----------------------
212  c* maximum-random  
213           ZCLEAR(JL) = ZCLEAR(JL)  
214       S                  *(1.0-MAX(ZSS0(JL),ZSCAT(JL)))            zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66
215       S                  /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC))            prmu0(jl, jk) = 1./zmue
216           ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL)  
217           ZSCAT(JL) = ZSS0(JL)  
218        ELSE IF (NOVLP.EQ.2) THEN            ! ------------------------------------------------------------------
219  C* maximum  
220           ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )            ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
221           ZC0I(JL,JKL) = ZSCAT(JL)            ! ----------------------------------------------------
222        ELSE IF (NOVLP.EQ.3) THEN  
223  c* random  
224           ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL))            zgap = pcgaz(jl, jkm1)
225           ZSCAT(JL) = 1.0 - ZCLEAR(JL)            zbmu0 = 0.5 - 0.75*zgap/zmue
226           ZC0I(JL,JKL) = ZSCAT(JL)            zww = ppizaz(jl, jkm1)
227        END IF                              zto = ptauaz(jl, jkm1)
228   204  CONTINUE            zden = 1. + (1.-zww+zbmu0*zww)*zto*zmue + (1-zww)*(1.-zww+2.*zbmu0*zww) &
229   205  CONTINUE                 *zto*zto*zmue*zmue
230  C            pray1(jl, jkm1) = zbmu0*zww*zto*zmue/zden
231  C     ------------------------------------------------------------------            ptra1(jl, jkm1) = 1./zden
232  C  
233  C*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING            zmu1 = 0.5
234  C                -----------------------------------------------            zbmu1 = 0.5 - 0.75*zgap*zmu1
235  C            zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &
236   300  CONTINUE                 )*zto*zto/zmu1/zmu1
237  C            pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1
238        DO 301 JL = 1, KDLON            ptra2(jl, jkm1) = 1./zden1
239        PRAY1(JL,KFLEV+1) = 0.  
240        PRAY2(JL,KFLEV+1) = 0.  
241        PREFZ(JL,2,1) = PALBP(JL,KNU)  
242        PREFZ(JL,1,1) = PALBP(JL,KNU)            prefz(jl, 1, jk) = (pray1(jl,jkm1)+prefz(jl,1,jkm1)*ptra1(jl,jkm1)* &
243        PTRA1(JL,KFLEV+1) = 1.                 ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1,jkm1)))
244        PTRA2(JL,KFLEV+1) = 1.  
245   301  CONTINUE            ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
246  C                 jkm1)))
247        DO 346 JK = 2 , KFLEV+1  
248        JKM1 = JK-1            prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)*ptra1(jl,jkm1)* &
249        DO 342 JL = 1, KDLON                 ptra2(jl,jkm1))
250  C  
251  C            ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
252  C     ------------------------------------------------------------------  
253  C         END DO
254  C*         3.1  EQUIVALENT ZENITH ANGLE      END DO
255  C               -----------------------      DO jl = 1, kdlon
256  C         zmue = (1.-zc0i(jl,1))*psec(jl) + zc0i(jl, 1)*1.66
257   310  CONTINUE         prmu0(jl, 1) = 1./zmue
258  C      END DO
259        ZMUE = (1.-ZC0I(JL,JK)) * PSEC(JL)  
260       S            + ZC0I(JL,JK) * 1.66  
261        PRMU0(JL,JK) = 1./ZMUE      ! ------------------------------------------------------------------
262  C  
263  C      ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
264  C     ------------------------------------------------------------------      ! -------------------------------------------------
265  C  
266  C*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS  
267  C               ----------------------------------------------------      IF (knu==1) THEN
268  C         jaj = 2
269   320  CONTINUE         DO jl = 1, kdlon
270  C            prj(jl, jaj, kflev+1) = 1.
271        ZGAP = PCGAZ(JL,JKM1)            prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
272        ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE         END DO
273        ZWW = PPIZAZ(JL,JKM1)  
274        ZTO = PTAUAZ(JL,JKM1)         DO jk = 1, kflev
275        ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE            jkl = kflev + 1 - jk
276       S       + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE            jklp1 = jkl + 1
277        PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN            DO jl = 1, kdlon
278        PTRA1(JL,JKM1) = 1. / ZDEN               zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)
279  C               prj(jl, jaj, jkl) = zre11
280        ZMU1 = 0.5               prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)
281        ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1            END DO
282        ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1         END DO
283       S       + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1  
284        PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1      ELSE
285        PTRA2(JL,JKM1) = 1. / ZDEN1  
286  C         DO jaj = 1, 2
287  C            DO jl = 1, kdlon
288  C               prj(jl, jaj, kflev+1) = 1.
289        PREFZ(JL,1,JK) = (PRAY1(JL,JKM1)               prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
290       S               + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)            END DO
291       S               * PTRA2(JL,JKM1)  
292       S               / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))            DO jk = 1, kflev
293  C               jkl = kflev + 1 - jk
294        ZTR(JL,1,JKM1) = (PTRA1(JL,JKM1)               jklp1 = jkl + 1
295       S               / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))               DO jl = 1, kdlon
296  C                  zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
297        PREFZ(JL,2,JK) = (PRAY1(JL,JKM1)                  prj(jl, jaj, jkl) = zre11
298       S               + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)                  prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
299       S               * PTRA2(JL,JKM1) )               END DO
300  C            END DO
301        ZTR(JL,2,JKM1) = PTRA1(JL,JKM1)         END DO
302  C  
303   342  CONTINUE      END IF
304   346  CONTINUE  
305        DO 347 JL = 1, KDLON    END SUBROUTINE swclr
306        ZMUE = (1.-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66  
307        PRMU0(JL,1)=1./ZMUE  end module swclr_m
  347  CONTINUE  
 C  
 C  
 C     ------------------------------------------------------------------  
 C  
 C*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL  
 C                 -------------------------------------------------  
 C  
  350  CONTINUE  
 C  
       IF (KNU.EQ.1) THEN  
       JAJ = 2  
       DO 351 JL = 1, KDLON  
       PRJ(JL,JAJ,KFLEV+1) = 1.  
       PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1)  
  351  CONTINUE  
 C  
       DO 353 JK = 1 , KFLEV  
       JKL = KFLEV+1 - JK  
       JKLP1 = JKL + 1  
       DO 352 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)  
  352  CONTINUE  
  353  CONTINUE  
  354  CONTINUE  
 C  
       ELSE  
 C  
       DO 358 JAJ = 1 , 2  
       DO 355 JL = 1, KDLON  
       PRJ(JL,JAJ,KFLEV+1) = 1.  
       PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1)  
  355  CONTINUE  
 C  
       DO 357 JK = 1 , KFLEV  
       JKL = KFLEV+1 - JK  
       JKLP1 = JKL + 1  
       DO 356 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)  
  356  CONTINUE  
  357  CONTINUE  
  358  CONTINUE  
 C  
       END IF  
 C  
 C     ------------------------------------------------------------------  
 C  
       RETURN  
       END  
Legend:
Removed from v.76  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21