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

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