/[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

revision 157 by guez, Mon Jul 20 16:01:49 2015 UTC revision 178 by guez, Fri Mar 11 18:47:26 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
6    ! PURPOSE.  
7    ! --------    SUBROUTINE swclr(knu, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
8    ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF         prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
9    ! CLEAR-SKY COLUMN         ptra1, ptra2)
10        USE dimens_m
11    ! REFERENCE.      USE dimphy
12    ! ----------      USE raddim
13        USE radepsi
14    ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT      USE radopt
15    ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)  
16        ! ------------------------------------------------------------------
17    ! AUTHOR.      ! PURPOSE.
18    ! -------      ! --------
19    ! JEAN-JACQUES MORCRETTE  *ECMWF*      ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
20        ! CLEAR-SKY COLUMN
21    ! MODIFICATIONS.  
22    ! --------------      ! REFERENCE.
23    ! ORIGINAL : 94-11-15      ! ----------
24    ! ------------------------------------------------------------------  
25    ! * ARGUMENTS:      ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
26        ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
27    INTEGER knu  
28    ! -OB      ! AUTHOR.
29    DOUBLE PRECISION flag_aer      ! -------
30    DOUBLE PRECISION tauae(kdlon, kflev, 2)      ! JEAN-JACQUES MORCRETTE  *ECMWF*
31    DOUBLE PRECISION pizae(kdlon, kflev, 2)  
32    DOUBLE PRECISION cgae(kdlon, kflev, 2)      ! MODIFICATIONS.
33    DOUBLE PRECISION paer(kdlon, kflev, 5)      ! --------------
34    DOUBLE PRECISION palbp(kdlon, 2)      ! ORIGINAL : 94-11-15
35    DOUBLE PRECISION pdsig(kdlon, kflev)      ! ------------------------------------------------------------------
36    DOUBLE PRECISION prayl(kdlon)      ! * ARGUMENTS:
37    DOUBLE PRECISION psec(kdlon)  
38        INTEGER knu
39    DOUBLE PRECISION pcgaz(kdlon, kflev)      ! -OB
40    DOUBLE PRECISION ppizaz(kdlon, kflev)      DOUBLE PRECISION flag_aer
41    DOUBLE PRECISION pray1(kdlon, kflev+1)      DOUBLE PRECISION tauae(kdlon, kflev, 2)
42    DOUBLE PRECISION pray2(kdlon, kflev+1)      DOUBLE PRECISION pizae(kdlon, kflev, 2)
43    DOUBLE PRECISION prefz(kdlon, 2, kflev+1)      DOUBLE PRECISION cgae(kdlon, kflev, 2)
44    DOUBLE PRECISION prj(kdlon, 6, kflev+1)      DOUBLE PRECISION palbp(kdlon, 2)
45    DOUBLE PRECISION prk(kdlon, 6, kflev+1)      DOUBLE PRECISION pdsig(kdlon, kflev)
46    DOUBLE PRECISION prmu0(kdlon, kflev+1)      DOUBLE PRECISION prayl(kdlon)
47    DOUBLE PRECISION ptauaz(kdlon, kflev)      DOUBLE PRECISION psec(kdlon)
48    DOUBLE PRECISION ptra1(kdlon, kflev+1)  
49    DOUBLE PRECISION ptra2(kdlon, kflev+1)      DOUBLE PRECISION pcgaz(kdlon, kflev)
50        DOUBLE PRECISION ppizaz(kdlon, kflev)
51    ! * LOCAL VARIABLES:      DOUBLE PRECISION pray1(kdlon, kflev+1)
52        DOUBLE PRECISION pray2(kdlon, kflev+1)
53    DOUBLE PRECISION zc0i(kdlon, kflev+1)      DOUBLE PRECISION prefz(kdlon, 2, kflev+1)
54    DOUBLE PRECISION zcle0(kdlon, kflev)      DOUBLE PRECISION prj(kdlon, 6, kflev+1)
55    DOUBLE PRECISION zclear(kdlon)      DOUBLE PRECISION prk(kdlon, 6, kflev+1)
56    DOUBLE PRECISION zr21(kdlon)      DOUBLE PRECISION prmu0(kdlon, kflev+1)
57    DOUBLE PRECISION zr23(kdlon)      DOUBLE PRECISION ptauaz(kdlon, kflev)
58    DOUBLE PRECISION zss0(kdlon)      DOUBLE PRECISION ptra1(kdlon, kflev+1)
59    DOUBLE PRECISION zscat(kdlon)      DOUBLE PRECISION ptra2(kdlon, kflev+1)
60    DOUBLE PRECISION ztr(kdlon, 2, kflev+1)  
61        ! * LOCAL VARIABLES:
62    INTEGER jl, jk, ja, jkl, jklp1, jaj, jkm1  
63    DOUBLE PRECISION ztray, zgar, zratio, zff, zfacoa, zcorae      DOUBLE PRECISION zc0i(kdlon, kflev+1)
64    DOUBLE PRECISION zmue, zgap, zww, zto, zden, zmu1, zden1      DOUBLE PRECISION zclear(kdlon)
65    DOUBLE PRECISION zbmu0, zbmu1, zre11      DOUBLE PRECISION zr21(kdlon)
66        DOUBLE PRECISION zss0(kdlon)
67    ! ------------------------------------------------------------------      DOUBLE PRECISION zscat(kdlon)
68        DOUBLE PRECISION ztr(kdlon, 2, kflev+1)
69    ! *         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH  
70    ! --------------------------------------------      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    DO jk = 1, kflev + 1      DOUBLE PRECISION zbmu0, zbmu1, zre11
74      DO ja = 1, 6  
75        DO jl = 1, kdlon      ! ------------------------------------------------------------------
76          prj(jl, ja, jk) = 0.  
77          prk(jl, ja, jk) = 0.      ! *         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
78        END DO      ! --------------------------------------------
79    
80    
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      END DO      END DO
   END DO  
89    
90    DO jk = 1, kflev      DO jk = 1, kflev
91      DO jl = 1, kdlon         DO jl = 1, kdlon
92        ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)            ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
93        ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)            ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
94        pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)            pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
95           END DO
96    
97           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      END DO
120    
121      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  
     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  
122    
123    DO jk = 2, kflev      ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
124        ! ----------------------------------------------
125    
126    
127        DO jl = 1, kdlon
128           zc0i(jl, kflev+1) = 0.
129           zclear(jl) = 1.
130           zscat(jl) = 0.
131        END DO
132    
133        jk = 1
134      jkl = kflev + 1 - jk      jkl = kflev + 1 - jk
135      jklp1 = jkl + 1      jklp1 = jkl + 1
136      DO jl = 1, kdlon      DO jl = 1, kdlon
137        zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)         zfacoa = 1. - ppizaz(jl, jkl)*pcgaz(jl, jkl)*pcgaz(jl, jkl)
138        zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)         zcorae = zfacoa*ptauaz(jl, jkl)*psec(jl)
139        zr21(jl) = exp(-zcorae)         zr21(jl) = exp(-zcorae)
140        zss0(jl) = 1. - zr21(jl)         zss0(jl) = 1. - zr21(jl)
141        zcle0(jl, jkl) = zss0(jl)  
142           IF (novlp==1) THEN
143        IF (novlp==1) THEN            ! * maximum-random
144          ! * maximum-random            zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &
145          zclear(jl) = zclear(jl)*(1.0-max(zss0(jl),zscat(jl)))/ &                 (1.0-min(zscat(jl),1.-zepsec))
146            (1.0-min(zscat(jl),1.-zepsec))            zc0i(jl, jkl) = 1.0 - zclear(jl)
147          zc0i(jl, jkl) = 1.0 - zclear(jl)            zscat(jl) = zss0(jl)
148          zscat(jl) = zss0(jl)         ELSE IF (novlp==2) THEN
149        ELSE IF (novlp==2) THEN            ! * maximum
150          ! * maximum            zscat(jl) = max(zss0(jl), zscat(jl))
151          zscat(jl) = max(zss0(jl), zscat(jl))            zc0i(jl, jkl) = zscat(jl)
152          zc0i(jl, jkl) = zscat(jl)         ELSE IF (novlp==3) THEN
153        ELSE IF (novlp==3) THEN            ! * random
154          ! * random            zclear(jl) = zclear(jl)*(1.0-zss0(jl))
155          zclear(jl) = zclear(jl)*(1.0-zss0(jl))            zscat(jl) = 1.0 - zclear(jl)
156          zscat(jl) = 1.0 - zclear(jl)            zc0i(jl, jkl) = zscat(jl)
157          zc0i(jl, jkl) = zscat(jl)         END IF
       END IF  
158      END DO      END DO
   END DO  
159    
160    ! ------------------------------------------------------------------      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 = zfacoa*ptauaz(jl, jkl)*psec(jl)
166              zr21(jl) = exp(-zcorae)
167              zss0(jl) = 1. - zr21(jl)
168    
169              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    
188    ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING      ! ------------------------------------------------------------------
   ! -----------------------------------------------  
189    
190        ! *         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
191        ! -----------------------------------------------
192    
   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  
193    
   DO jk = 2, kflev + 1  
     jkm1 = jk - 1  
194      DO jl = 1, kdlon      DO jl = 1, kdlon
195           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    
203        DO jk = 2, kflev + 1
204           jkm1 = jk - 1
205           DO jl = 1, kdlon
206    
       ! ------------------------------------------------------------------  
207    
208        ! *         3.1  EQUIVALENT ZENITH ANGLE            ! ------------------------------------------------------------------
       ! -----------------------  
209    
210              ! *         3.1  EQUIVALENT ZENITH ANGLE
211              ! -----------------------
212    
       zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66  
       prmu0(jl, jk) = 1./zmue  
213    
214              zmue = (1.-zc0i(jl,jk))*psec(jl) + zc0i(jl, jk)*1.66
215              prmu0(jl, jk) = 1./zmue
216    
       ! ------------------------------------------------------------------  
217    
218        ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS            ! ------------------------------------------------------------------
       ! ----------------------------------------------------  
219    
220              ! *         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
221              ! ----------------------------------------------------
222    
       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  
223    
224        zmu1 = 0.5            zgap = pcgaz(jl, jkm1)
225        zbmu1 = 0.5 - 0.75*zgap*zmu1            zbmu0 = 0.5 - 0.75*zgap/zmue
226        zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &            zww = ppizaz(jl, jkm1)
227          )*zto*zto/zmu1/zmu1            zto = ptauaz(jl, jkm1)
228        pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1            zden = 1. + (1.-zww+zbmu0*zww)*zto*zmue + (1-zww)*(1.-zww+2.*zbmu0*zww) &
229        ptra2(jl, jkm1) = 1./zden1                 *zto*zto*zmue*zmue
230              pray1(jl, jkm1) = zbmu0*zww*zto*zmue/zden
231              ptra1(jl, jkm1) = 1./zden
232    
233              zmu1 = 0.5
234              zbmu1 = 0.5 - 0.75*zgap*zmu1
235              zden1 = 1. + (1.-zww+zbmu1*zww)*zto/zmu1 + (1-zww)*(1.-zww+2.*zbmu1*zww &
236                   )*zto*zto/zmu1/zmu1
237              pray2(jl, jkm1) = zbmu1*zww*zto/zmu1/zden1
238              ptra2(jl, jkm1) = 1./zden1
239    
240    
       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)))  
241    
242        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)* &
243          jkm1)))                 ptra2(jl,jkm1)/(1.-pray2(jl,jkm1)*prefz(jl,1,jkm1)))
244    
245        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, &
246          ptra2(jl,jkm1))                 jkm1)))
247    
248        ztr(jl, 2, jkm1) = ptra1(jl, jkm1)            prefz(jl, 2, jk) = (pray1(jl,jkm1)+prefz(jl,2,jkm1)*ptra1(jl,jkm1)* &
249                   ptra2(jl,jkm1))
250    
251      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  
252    
253           END DO
254        END DO
255        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    
   ! ------------------------------------------------------------------  
260    
261    ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL      ! ------------------------------------------------------------------
   ! -------------------------------------------------  
262    
263        ! *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
264        ! -------------------------------------------------
265    
   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  
266    
267      DO jk = 1, kflev      IF (knu==1) THEN
268        jkl = kflev + 1 - jk         jaj = 2
269        jklp1 = jkl + 1         DO jl = 1, kdlon
270        DO jl = 1, kdlon            prj(jl, jaj, kflev+1) = 1.
271          zre11 = prj(jl, jaj, jklp1)*ztr(jl, 1, jkl)            prk(jl, jaj, kflev+1) = prefz(jl, 1, kflev+1)
272          prj(jl, jaj, jkl) = zre11         END DO
273          prk(jl, jaj, jkl) = zre11*prefz(jl, 1, jkl)  
274        END DO         DO jk = 1, kflev
275      END DO            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    
284    ELSE      ELSE
285    
286      DO jaj = 1, 2         DO jaj = 1, 2
287        DO jl = 1, kdlon            DO jl = 1, kdlon
288          prj(jl, jaj, kflev+1) = 1.               prj(jl, jaj, kflev+1) = 1.
289          prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)               prk(jl, jaj, kflev+1) = prefz(jl, jaj, kflev+1)
290        END DO            END DO
291    
292        DO jk = 1, kflev            DO jk = 1, kflev
293          jkl = kflev + 1 - jk               jkl = kflev + 1 - jk
294          jklp1 = jkl + 1               jklp1 = jkl + 1
295          DO jl = 1, kdlon               DO jl = 1, kdlon
296            zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)                  zre11 = prj(jl, jaj, jklp1)*ztr(jl, jaj, jkl)
297            prj(jl, jaj, jkl) = zre11                  prj(jl, jaj, jkl) = zre11
298            prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)                  prk(jl, jaj, jkl) = zre11*prefz(jl, jaj, jkl)
299          END DO               END DO
300        END DO            END DO
301      END DO         END DO
302    
303    END IF      END IF
304    
305    ! ------------------------------------------------------------------    END SUBROUTINE swclr
306    
307    RETURN  end module swclr_m
 END SUBROUTINE swclr  
Legend:
Removed from v.157  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21