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