/[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 105 by guez, Thu Sep 4 10:40:24 2014 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, 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, 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, &
8      ! -OB         prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, ptauaz, &
9      ! DO 104 JL = 1, KDLON         ptra1, ptra2)
10      ! PCGAZ(JL,JK) = 0.      USE dimens_m
11      ! PPIZAZ(JL,JK) =  0.      USE dimphy
12      ! PTAUAZ(JL,JK) = 0.      USE raddim
13      ! 104  CONTINUE      USE radepsi
14      ! -OB      USE radopt
15      ! DO 106 JAE=1,5  
16      ! DO 105 JL = 1, KDLON      ! ------------------------------------------------------------------
17      ! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)      ! PURPOSE.
18      ! S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)      ! --------
19      ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)      ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
20      ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)      ! CLEAR-SKY COLUMN
21      ! PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)  
22      ! S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)      ! REFERENCE.
23      ! 105  CONTINUE      ! ----------
24      ! 106  CONTINUE  
25        ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
26        ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
27    
28        ! AUTHOR.
29        ! -------
30        ! JEAN-JACQUES MORCRETTE  *ECMWF*
31    
32        ! MODIFICATIONS.
33        ! --------------
34        ! ORIGINAL : 94-11-15
35        ! ------------------------------------------------------------------
36        ! * ARGUMENTS:
37    
38        INTEGER knu
39      ! -OB      ! -OB
40      DO jl = 1, kdlon      DOUBLE PRECISION flag_aer
41        ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)      DOUBLE PRECISION tauae(kdlon, kflev, 2)
42        ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)      DOUBLE PRECISION pizae(kdlon, kflev, 2)
43        pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)      DOUBLE PRECISION cgae(kdlon, kflev, 2)
44        DOUBLE PRECISION palbp(kdlon, 2)
45        DOUBLE PRECISION pdsig(kdlon, kflev)
46        DOUBLE PRECISION prayl(kdlon)
47        DOUBLE PRECISION psec(kdlon)
48    
49        DOUBLE PRECISION pcgaz(kdlon, kflev)
50        DOUBLE PRECISION ppizaz(kdlon, kflev)
51        DOUBLE PRECISION pray1(kdlon, kflev+1)
52        DOUBLE PRECISION pray2(kdlon, kflev+1)
53        DOUBLE PRECISION prefz(kdlon, 2, kflev+1)
54        DOUBLE PRECISION prj(kdlon, 6, kflev+1)
55        DOUBLE PRECISION prk(kdlon, 6, kflev+1)
56        DOUBLE PRECISION prmu0(kdlon, kflev+1)
57        DOUBLE PRECISION ptauaz(kdlon, kflev)
58        DOUBLE PRECISION ptra1(kdlon, kflev+1)
59        DOUBLE PRECISION ptra2(kdlon, kflev+1)
60    
61        ! * LOCAL VARIABLES:
62    
63        DOUBLE PRECISION zc0i(kdlon, kflev+1)
64        DOUBLE PRECISION zclear(kdlon)
65        DOUBLE PRECISION zr21(kdlon)
66        DOUBLE PRECISION zss0(kdlon)
67        DOUBLE PRECISION zscat(kdlon)
68        DOUBLE PRECISION ztr(kdlon, 2, kflev+1)
69    
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        DOUBLE PRECISION zbmu0, zbmu1, zre11
74    
75        ! ------------------------------------------------------------------
76    
77        ! *         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
78        ! --------------------------------------------
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
89    
90      IF (flag_aer>0) THEN      DO jk = 1, kflev
91        ! -OB         DO jl = 1, kdlon
92        DO jl = 1, kdlon            ptauaz(jl, jk) = flag_aer*tauae(jl, jk, knu)
93          ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)            ppizaz(jl, jk) = flag_aer*pizae(jl, jk, knu)
94          ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)            pcgaz(jl, jk) = flag_aer*cgae(jl, jk, knu)
95          ztray = prayl(jl)*pdsig(jl, jk)         END DO
96          zratio = ztray/(ztray+ptauaz(jl,jk))  
97          zgar = pcgaz(jl, jk)         IF (flag_aer>0) THEN
98          zff = zgar*zgar            ! -OB
99          ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)            DO jl = 1, kdlon
100          pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)               ! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
101          ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &               ! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
102            ppizaz(jl,jk)*zff)               ztray = prayl(jl)*pdsig(jl, jk)
103        END DO               zratio = ztray/(ztray+ptauaz(jl,jk))
104      ELSE               zgar = pcgaz(jl, jk)
105        DO jl = 1, kdlon               zff = zgar*zgar
106          ztray = prayl(jl)*pdsig(jl, jk)               ptauaz(jl, jk) = ztray + ptauaz(jl, jk)*(1.-ppizaz(jl,jk)*zff)
107          ptauaz(jl, jk) = ztray               pcgaz(jl, jk) = zgar*(1.-zratio)/(1.+zgar)
108          pcgaz(jl, jk) = 0.               ppizaz(jl, jk) = zratio + (1.-zratio)*ppizaz(jl, jk)*(1.-zff)/(1.- &
109          ppizaz(jl, jk) = 1. - repsct                    ppizaz(jl,jk)*zff)
110        END DO            END DO
111      END IF ! check flag_aer         ELSE
112      ! 107  CONTINUE            DO jl = 1, kdlon
113      ! PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)               ztray = prayl(jl)*pdsig(jl, jk)
114      ! $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)               ptauaz(jl, jk) = ztray
115      ! 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)               pcgaz(jl, jk) = 0.
116                 ppizaz(jl, jk) = 1. - repsct
117    END DO            END DO
118           END IF ! check flag_aer
119    ! ------------------------------------------------------------------      END DO
120    
121    ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL      ! ------------------------------------------------------------------
122    ! ----------------------------------------------  
123        ! *         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
124        ! ----------------------------------------------
   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  
125    
126    DO jk = 2, kflev  
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.105  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21