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

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

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

trunk/phylmd/Radlwsw/swclr.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/Radlwsw/swclr.f revision 208 by guez, Wed Dec 7 16:44:53 2016 UTC
# Line 1  Line 1 
1  SUBROUTINE swclr(knu, paer, flag_aer, tauae, pizae, cgae, palbp, pdsig, &  module swclr_m
2      prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &  
     ptra1, ptra2)  
   USE dimens_m  
   USE dimphy  
   USE raddim  
   USE radepsi  
   USE radopt  
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! ------------------------------------------------------------------  contains
   ! 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, jae, 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  
6    
7    DO jk = 1, kflev    SUBROUTINE swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, prayl, &
8      ! -OB         psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
9      ! DO 104 JL = 1, KDLON         ptra1, ptra2)
10      ! PCGAZ(JL,JK) = 0.      
11      ! PPIZAZ(JL,JK) =  0.      USE raddim, only: kdlon, kflev
12      ! PTAUAZ(JL,JK) = 0.      USE radepsi, only: repsct, zepsec
13      ! 104  CONTINUE      USE radopt, only: novlp
14      ! -OB  
15      ! DO 106 JAE=1,5      ! ------------------------------------------------------------------
16      ! DO 105 JL = 1, KDLON      ! PURPOSE.
17      ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)      ! --------
18      ! S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)      ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
19      ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)      ! CLEAR-SKY COLUMN
20      ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)  
21      ! PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)      ! REFERENCE.
22      ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)      ! ----------
23      ! 105  CONTINUE  
24      ! 106  CONTINUE      ! 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      ! -OB
39      DO jl = 1, kdlon      DOUBLE PRECISION flag_aer
40        ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)      DOUBLE PRECISION tauae(kdlon, kflev, 2)
41        ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)      DOUBLE PRECISION pizae(kdlon, kflev, 2)
42        pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)      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      END DO
88    
89      IF (flag_aer>0) THEN      DO jk = 1, kflev
90        ! -OB         DO jl = 1, kdlon
91        DO jl = 1, kdlon            ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
92          ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)            ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
93          ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)            pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
94          ztray = prayl(jl)*pdsig(jl, jk)         END DO
95          zratio = ztray/(ztray+ptauaz(jl,jk))  
96          zgar = pcgaz(jl, jk)         IF (flag_aer>0) THEN
97          zff = zgar*zgar            ! -OB
98          ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)            DO jl = 1, kdlon
99          pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)               ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
100          ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &               ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
101            ppizaz(jl,jk)*zff)               ztray = prayl(jl)*pdsig(jl, jk)
102        END DO               zratio = ztray/(ztray+ptauaz(jl,jk))
103      ELSE               zgar = pcgaz(jl, jk)
104        DO jl = 1, kdlon               zff = zgar*zgar
105          ztray = prayl(jl)*pdsig(jl, jk)               ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)
106          ptauaz(jl, jk) = ztray               pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)
107          pcgaz(jl, jk) = 0.               ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &
108          ppizaz(jl, jk) = 1. - repsct                    ppizaz(jl,jk)*zff)
109        END DO            END DO
110      END IF ! check flag_aer         ELSE
111      ! 107  CONTINUE            DO jl = 1, kdlon
112      ! PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)               ztray = prayl(jl)*pdsig(jl, jk)
113      ! $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)               ptauaz(jl, jk) = ztray
114      ! 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)               pcgaz(jl, jk) = 0.
115                 ppizaz(jl, jk) = 1. - repsct
116    END DO            END DO
117           END IF ! check flag_aer
118    ! ------------------------------------------------------------------      END DO
119    
120    ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL      ! ------------------------------------------------------------------
121    ! ----------------------------------------------  
122        ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
123        ! ----------------------------------------------
   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  
124    
125    DO jk = 2, kflev  
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      jkl = kflev + 1 - jk
134      jklp1 = jkl + 1      jklp1 = jkl + 1
135      DO jl = 1, kdlon      DO jl = 1, kdlon
136        zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)         zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
137        zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)         zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
138        zr21(jl) = exp(-zcorae)         zr21(jl) = exp(-zcorae)
139        zss0(jl) = 1. - zr21(jl)         zss0(jl) = 1. - zr21(jl)
140        zcle0(jl, jkl) = zss0(jl)  
141           IF (novlp==1) THEN
142        IF (novlp==1) THEN            ! * maximum-random
143          ! * maximum-random            zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
144          zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &                 (1.0-min(zscat(jl),1.-zepsec))
145            (1.0-min(zscat(jl),1.-zepsec))            zc0i(jl, jkl) = 1.0 - zclear(jl)
146          zc0i(jl, jkl) = 1.0 - zclear(jl)            zscat(jl) = zss0(jl)
147          zscat(jl) = zss0(jl)         ELSE IF (novlp==2) THEN
148        ELSE IF (novlp==2) THEN            ! * maximum
149          ! * maximum            zscat(jl) = max(zss0(jl), zscat(jl))
150          zscat(jl) = max(zss0(jl), zscat(jl))            zc0i(jl, jkl) = zscat(jl)
151          zc0i(jl, jkl) = zscat(jl)         ELSE IF (novlp==3) THEN
152        ELSE IF (novlp==3) THEN            ! * random
153          ! * random            zclear(jl) = zclear(jl)*(1.0-zss0(jl))
154          zclear(jl) = zclear(jl)*(1.0-zss0(jl))            zscat(jl) = 1.0 - zclear(jl)
155          zscat(jl) = 1.0 - zclear(jl)            zc0i(jl, jkl) = zscat(jl)
156          zc0i(jl, jkl) = zscat(jl)         END IF
       END IF  
157      END DO      END DO
   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 = zfacoa*ptauaz(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    ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING      ! ------------------------------------------------------------------
   ! -----------------------------------------------  
188    
189        ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
190        ! -----------------------------------------------
191    
   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  
192    
   DO jk = 2, kflev + 1  
     jkm1 = jk - 1  
193      DO jl = 1, kdlon      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        ! *         3.1  EQUIVALENT ZENITH ANGLE            ! ------------------------------------------------------------------
       ! -----------------------  
208    
209              ! *         3.1  EQUIVALENT ZENITH ANGLE
210              ! -----------------------
211    
       zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66  
       prmu0(jl, jk) = 1./zmue  
212    
213              zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66
214              prmu0(jl, jk) = 1./zmue
215    
       ! ------------------------------------------------------------------  
216    
217        ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS            ! ------------------------------------------------------------------
       ! ----------------------------------------------------  
218    
219              ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
220              ! ----------------------------------------------------
221    
       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  
222    
223        zmu1 = 0.5            zgap = pcgaz(jl, jkm1)
224        zbmu1 = 0.5 - 0.75*zgap*zmu1            zbmu0 = 0.5 - 0.75*zgap/zmue
225        zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &            zww = ppizaz(jl, jkm1)
226          )*zto*zto/zmu1/zmu1            zto = ptauaz(jl, jkm1)
227        pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1            zden = 1. + (1.-zww+zbmu0*zww)*zto*zmue + (1-zww)*(1.-zww+2.*zbmu0*zww) &
228        ptra2(jl, jkm1) = 1./zden1                 *zto*zto*zmue*zmue
229              pray1(jl, jkm1) = zbmu0*zww*zto*zmue/zden
230              ptra1(jl, jkm1) = 1./zden
231    
232              zmu1 = 0.5
233              zbmu1 = 0.5 - 0.75*zgap*zmu1
234              zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &
235                   )*zto*zto/zmu1/zmu1
236              pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1
237              ptra2(jl, jkm1) = 1./zden1
238    
239    
       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)))  
240    
241        ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &            prefz(jl, 1, jk) = (pray1(jl,jkm1)+prefz(jl,1,jkm1)*ptra1(jl,jkm1)* &
242          jkm1)))                 ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1,jkm1)))
243    
244        prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)*ptra1(jl,jkm1)* &            ztr(jl, 1, jkm1) = (ptra1(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1, &
245          ptra2(jl,jkm1))                 jkm1)))
246    
247        ztr(jl, 2, jkm1) = ptra1(jl, jkm1)            prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)*ptra1(jl,jkm1)* &
248                   ptra2(jl,jkm1))
249    
250      END DO            ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
   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  
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    ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL      ! ------------------------------------------------------------------
   ! -------------------------------------------------  
261    
262        ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
263        ! -------------------------------------------------
264    
   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  
265    
266      DO jk = 1, kflev      IF (knu==1) THEN
267        jkl = kflev + 1 - jk         jaj = 2
268        jklp1 = jkl + 1         DO jl = 1, kdlon
269        DO jl = 1, kdlon            prj(jl, jaj, kflev+1) = 1.
270          zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)            prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
271          prj(jl, jaj, jkl) = zre11         END DO
272          prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)  
273        END DO         DO jk = 1, kflev
274      END DO            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      ELSE
284    
285      DO jaj = 1, 2         DO jaj = 1, 2
286        DO jl = 1, kdlon            DO jl = 1, kdlon
287          prj(jl, jaj, kflev+1) = 1.               prj(jl, jaj, kflev+1) = 1.
288          prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)               prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
289        END DO            END DO
290    
291        DO jk = 1, kflev            DO jk = 1, kflev
292          jkl = kflev + 1 - jk               jkl = kflev + 1 - jk
293          jklp1 = jkl + 1               jklp1 = jkl + 1
294          DO jl = 1, kdlon               DO jl = 1, kdlon
295            zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)                  zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
296            prj(jl, jaj, jkl) = zre11                  prj(jl, jaj, jkl) = zre11
297            prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)                  prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
298          END DO               END DO
299        END DO            END DO
300      END DO         END DO
301    
302    END IF      END IF
303    
304    ! ------------------------------------------------------------------    END SUBROUTINE swclr
305    
306    RETURN  end module swclr_m
 END SUBROUTINE swclr  
Legend:
Removed from v.82  
changed lines
  Added in v.208
  ViewVC Help
Powered by ViewVC 1.1.21