/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwvb.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/lwvb.f

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

trunk/libf/phylmd/Radlwsw/lwvb.f revision 24 by guez, Wed Mar 3 13:23:49 2010 UTC trunk/phylmd/Radlwsw/lwvb.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 1  Line 1 
1        SUBROUTINE LWVB(KUAER,KTRAER, KLIM  SUBROUTINE lwvb(kuaer, ktraer, klim, pabcu, padjd, padju, pb, pbint, pbsui, &
2       R  , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP      pbsur, pbtop, pdisd, pdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &
3       R  , PDISD,PDISU,PEMIS,PPMB      pgatop, pgbtop, pcts, pfluc)
4       R  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP    USE dimens_m
5       S  , PCTS,PFLUC)    USE dimphy
6        use dimens_m    USE raddim
7        use dimphy    USE radopt
8        use raddim    USE raddimlw
9        use radopt    IMPLICIT NONE
10              use raddimlw  
11        IMPLICIT none    ! -----------------------------------------------------------------------
12  C    ! PURPOSE.
13  C-----------------------------------------------------------------------    ! --------
14  C     PURPOSE.    ! INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
15  C     --------    ! INTEGRATION
16  C           INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL  
17  C           INTEGRATION    ! METHOD.
18  C    ! -------
19  C     METHOD.  
20  C     -------    ! 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
21  C    ! ATMOSPHERE
22  C          1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE    ! 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
23  C     ATMOSPHERE    ! TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
24  C          2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND    ! 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
25  C     TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA  
26  C          3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES    ! REFERENCE.
27  C    ! ----------
28  C     REFERENCE.  
29  C     ----------    ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
30  C    ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
31  C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND  
32  C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS    ! AUTHOR.
33  C    ! -------
34  C     AUTHOR.    ! JEAN-JACQUES MORCRETTE  *ECMWF*
35  C     -------  
36  C        JEAN-JACQUES MORCRETTE  *ECMWF*    ! MODIFICATIONS.
37  C    ! --------------
38  C     MODIFICATIONS.    ! ORIGINAL : 89-07-14
39  C     --------------    ! Voigt lines (loop 2413 to 2427)  - JJM & PhD - 01/96
40  C        ORIGINAL : 89-07-14    ! -----------------------------------------------------------------------
41  C        Voigt lines (loop 2413 to 2427)  - JJM & PhD - 01/96  
42  C-----------------------------------------------------------------------    ! *       0.1   ARGUMENTS
43  C    ! ---------
44  C*       0.1   ARGUMENTS  
45  C              ---------    INTEGER kuaer, ktraer, klim
46  C  
47        INTEGER KUAER,KTRAER, KLIM    DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! ABSORBER AMOUNTS
48  C    DOUBLE PRECISION padjd(kdlon, kflev+1) ! CONTRIBUTION BY ADJACENT LAYERS
49        REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS    DOUBLE PRECISION padju(kdlon, kflev+1) ! CONTRIBUTION BY ADJACENT LAYERS
50        REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS    DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
51        REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS    DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
52        REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS    DOUBLE PRECISION pbsur(kdlon, ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
53        REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS    DOUBLE PRECISION pbsui(kdlon) ! SURFACE PLANCK FUNCTION
54        REAL*8 PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION    DOUBLE PRECISION pbtop(kdlon, ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
55        REAL*8 PBSUI(KDLON) ! SURFACE PLANCK FUNCTION    DOUBLE PRECISION pdisd(kdlon, kflev+1) ! CONTRIBUTION BY DISTANT LAYERS
56        REAL*8 PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION    DOUBLE PRECISION pdisu(kdlon, kflev+1) ! CONTRIBUTION BY DISTANT LAYERS
57        REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS    DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY
58        REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS    DOUBLE PRECISION ppmb(kdlon, kflev+1) ! PRESSURE MB
59        REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY    DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
60        REAL*8 PPMB(KDLON,KFLEV+1) ! PRESSURE MB    DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
61        REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS    DOUBLE PRECISION pgasur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
62        REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS    DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
63        REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS    DOUBLE PRECISION pgatop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
64        REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS    DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
65        REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS  
66        REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS    DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
67  C    DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
68        REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES  
69        REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM    ! * LOCAL VARIABLES:
70  C  
71  C* LOCAL VARIABLES:    DOUBLE PRECISION zbgnd(kdlon)
72  C    DOUBLE PRECISION zfd(kdlon)
73        REAL*8 ZBGND(KDLON)    DOUBLE PRECISION zfn10(kdlon)
74        REAL*8 ZFD(KDLON)    DOUBLE PRECISION zfu(kdlon)
75        REAL*8  ZFN10(KDLON)    DOUBLE PRECISION ztt(kdlon, ntra)
76        REAL*8 ZFU(KDLON)    DOUBLE PRECISION ztt1(kdlon, ntra)
77        REAL*8  ZTT(KDLON,NTRA)    DOUBLE PRECISION ztt2(kdlon, ntra)
78        REAL*8 ZTT1(KDLON,NTRA)    DOUBLE PRECISION zuu(kdlon, nua)
79        REAL*8 ZTT2(KDLON,NTRA)    DOUBLE PRECISION zcnsol(kdlon)
80        REAL*8  ZUU(KDLON,NUA)    DOUBLE PRECISION zcntop(kdlon)
81        REAL*8 ZCNSOL(KDLON)  
82        REAL*8 ZCNTOP(KDLON)    INTEGER jk, jl, ja
83  C    INTEGER jstra, jstru
84        INTEGER jk, jl, ja    INTEGER ind1, ind2, ind3, ind4, in, jlim
85        INTEGER jstra, jstru    DOUBLE PRECISION zctstr
86        INTEGER ind1, ind2, ind3, ind4, in, jlim    ! -----------------------------------------------------------------------
87        REAL*8 zctstr  
88  C-----------------------------------------------------------------------    ! *         1.    INITIALIZATION
89  C    ! --------------
90  C*         1.    INITIALIZATION  
91  C                --------------  
92  C  
93   100  CONTINUE    ! *         1.2     INITIALIZE TRANSMISSION FUNCTIONS
94  C    ! ---------------------------------
95  C  
96  C*         1.2     INITIALIZE TRANSMISSION FUNCTIONS  
97  C                  ---------------------------------    DO ja = 1, ntra
98  C      DO jl = 1, kdlon
99   120  CONTINUE        ztt(jl, ja) = 1.0
100  C        ztt1(jl, ja) = 1.0
101        DO 122 JA=1,NTRA        ztt2(jl, ja) = 1.0
102        DO 121 JL=1, KDLON      END DO
103        ZTT (JL,JA)=1.0    END DO
104        ZTT1(JL,JA)=1.0  
105        ZTT2(JL,JA)=1.0    DO ja = 1, nua
106   121  CONTINUE      DO jl = 1, kdlon
107   122  CONTINUE        zuu(jl, ja) = 1.0
108  C      END DO
109        DO 124 JA=1,NUA    END DO
110        DO 123 JL=1, KDLON  
111        ZUU(JL,JA)=1.0    ! ------------------------------------------------------------------
112   123  CONTINUE  
113   124  CONTINUE    ! *         2.      VERTICAL INTEGRATION
114  C    ! --------------------
115  C     ------------------------------------------------------------------  
116  C  
117  C*         2.      VERTICAL INTEGRATION    ind1 = 0
118  C                  --------------------    ind3 = 0
119  C    ind4 = 1
120   200  CONTINUE    ind2 = 1
121  C  
122        IND1=0  
123        IND3=0    ! *         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
124        IND4=1    ! -----------------------------------
125        IND2=1  
126  C  
127  C    DO jk = 1, kflev
128  C*         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE      in = (jk-1)*ng1p1 + 1
129  C                  -----------------------------------  
130  C      DO ja = 1, kuaer
131   230  CONTINUE        DO jl = 1, kdlon
132  C          zuu(jl, ja) = pabcu(jl, ja, in)
133        DO 235 JK = 1 , KFLEV        END DO
134        IN=(JK-1)*NG1P1+1      END DO
135  C  
136        DO 232 JA=1,KUAER  
137        DO 231 JL=1, KDLON      CALL lwtt(pgatop(1,1,1), pgbtop(1,1,1), zuu, ztt)
138        ZUU(JL,JA)=PABCU(JL,JA,IN)  
139   231  CONTINUE      DO jl = 1, kdlon
140   232  CONTINUE        zcntop(jl) = pbtop(jl, 1)*ztt(jl, 1)*ztt(jl, 10) + &
141  C          pbtop(jl, 2)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
142  C          pbtop(jl, 3)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
143        CALL LWTT(PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT)          pbtop(jl, 4)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
144  C          pbtop(jl, 5)*ztt(jl, 3)*ztt(jl, 14) + pbtop(jl, 6)*ztt(jl, 6)*ztt(jl, &
145        DO 234 JL = 1, KDLON          15)
146        ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1)          *ZTT(JL,10)        zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
147       2      +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)        pfluc(jl, 2, jk) = zfd(jl)
148       3      +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)      END DO
149       4      +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)  
150       5      +PBTOP(JL,5)*ZTT(JL,3)          *ZTT(JL,14)    END DO
151       6      +PBTOP(JL,6)*ZTT(JL,6)          *ZTT(JL,15)  
152        ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)    jk = kflev + 1
153        PFLUC(JL,2,JK)=ZFD(JL)    in = (jk-1)*ng1p1 + 1
154   234  CONTINUE  
155  C    DO jl = 1, kdlon
156   235  CONTINUE      zcntop(jl) = pbtop(jl, 1) + pbtop(jl, 2) + pbtop(jl, 3) + pbtop(jl, 4) + &
157  C        pbtop(jl, 5) + pbtop(jl, 6)
158        JK = KFLEV+1      zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
159        IN=(JK-1)*NG1P1+1      pfluc(jl, 2, jk) = zfd(jl)
160  C    END DO
161        DO 236 JL = 1, KDLON  
162        ZCNTOP(JL)= PBTOP(JL,1)    ! *         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
163       1   + PBTOP(JL,2)    ! ---------------------------------------
164       2   + PBTOP(JL,3)  
165       3   + PBTOP(JL,4)  
166       4   + PBTOP(JL,5)  
167       5   + PBTOP(JL,6)    ! *         2.4.1   INITIALIZATION
168        ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)    ! --------------
169        PFLUC(JL,2,JK)=ZFD(JL)  
170   236  CONTINUE  
171  C    jlim = kflev
172  C*         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA  
173  C                  ---------------------------------------    IF (.NOT. levoigt) THEN
174  C      DO jk = kflev, 1, -1
175   240  CONTINUE        IF (ppmb(1,jk)<10.0) THEN
176  C          jlim = jk
177  C        END IF
178  C*         2.4.1   INITIALIZATION      END DO
179  C                  --------------    END IF
180  C    klim = jlim
181   2410 CONTINUE  
182  C    IF (.NOT. levoigt) THEN
183        JLIM = KFLEV      DO ja = 1, ktraer
184  C        DO jl = 1, kdlon
185        IF (.NOT.LEVOIGT) THEN          ztt1(jl, ja) = 1.0
186        DO 2412 JK = KFLEV,1,-1        END DO
187        IF(PPMB(1,JK).LT.10.0) THEN      END DO
188           JLIM=JK  
189        ENDIF        ! *         2.4.2   LOOP OVER LAYERS ABOVE 10 HPA
190   2412 CONTINUE      ! -----------------------------
191        ENDIF  
192        KLIM=JLIM  
193  C      DO jstra = kflev, jlim, -1
194        IF (.NOT.LEVOIGT) THEN        jstru = (jstra-1)*ng1p1 + 1
195          DO 2414 JA=1,KTRAER  
196          DO 2413 JL=1, KDLON        DO ja = 1, kuaer
197          ZTT1(JL,JA)=1.0          DO jl = 1, kdlon
198   2413   CONTINUE            zuu(jl, ja) = pabcu(jl, ja, jstru)
199   2414   CONTINUE          END DO
200  C        END DO
201  C*         2.4.2   LOOP OVER LAYERS ABOVE 10 HPA  
202  C                  -----------------------------  
203  C        CALL lwtt(pga(1,1,1,jstra), pgb(1,1,1,jstra), zuu, ztt)
204   2420   CONTINUE  
205  C        DO jl = 1, kdlon
206          DO 2427 JSTRA = KFLEV,JLIM,-1          zctstr = (pb(jl,1,jstra)+pb(jl,1,jstra+1))* &
207          JSTRU=(JSTRA-1)*NG1P1+1            (ztt1(jl,1)*ztt1(jl,10)-ztt(jl,1)*ztt(jl,10)) + &
208  C            (pb(jl,2,jstra)+pb(jl,2,jstra+1))*(ztt1(jl,2)*ztt1(jl,7)*ztt1(jl,11 &
209          DO 2423 JA=1,KUAER            )-ztt(jl,2)*ztt(jl,7)*ztt(jl,11)) + (pb(jl,3,jstra)+pb(jl,3,jstra+1 &
210          DO 2422 JL=1, KDLON            ))*(ztt1(jl,4)*ztt1(jl,8)*ztt1(jl,12)-ztt(jl,4)*ztt(jl,8)*ztt(jl,12 &
211          ZUU(JL,JA)=PABCU(JL,JA,JSTRU)            )) + (pb(jl,4,jstra)+pb(jl,4,jstra+1))*(ztt1(jl,5)*ztt1(jl,9)*ztt1( &
212   2422   CONTINUE            jl,13)-ztt(jl,5)*ztt(jl,9)*ztt(jl,13)) + (pb(jl,5,jstra)+pb(jl,5, &
213   2423   CONTINUE            jstra+1))*(ztt1(jl,3)*ztt1(jl,14)-ztt(jl,3)*ztt(jl,14)) + &
214  C            (pb(jl,6,jstra)+pb(jl,6,jstra+1))*(ztt1(jl,6)*ztt1(jl,15)-ztt(jl,6) &
215  C            *ztt(jl,15))
216          CALL LWTT(PGA(1,1,1,JSTRA), PGB(1,1,1,JSTRA), ZUU, ZTT)          pcts(jl, jstra) = zctstr*0.5
217  C        END DO
218          DO 2424 JL = 1, KDLON        DO ja = 1, ktraer
219          ZCTSTR =          DO jl = 1, kdlon
220       1   (PB(JL,1,JSTRA)+PB(JL,1,JSTRA+1))            ztt1(jl, ja) = ztt(jl, ja)
221       1       *(ZTT1(JL,1)           *ZTT1(JL,10)          END DO
222       1       - ZTT (JL,1)           *ZTT (JL,10))        END DO
223       2  +(PB(JL,2,JSTRA)+PB(JL,2,JSTRA+1))      END DO
224       2       *(ZTT1(JL,2)*ZTT1(JL,7)*ZTT1(JL,11)    END IF
225       2       - ZTT (JL,2)*ZTT (JL,7)*ZTT (JL,11))    ! Mise a zero de securite pour PCTS en cas de LEVOIGT
226       3  +(PB(JL,3,JSTRA)+PB(JL,3,JSTRA+1))    IF (levoigt) THEN
227       3       *(ZTT1(JL,4)*ZTT1(JL,8)*ZTT1(JL,12)      DO jstra = 1, kflev
228       3       - ZTT (JL,4)*ZTT (JL,8)*ZTT (JL,12))        DO jl = 1, kdlon
229       4  +(PB(JL,4,JSTRA)+PB(JL,4,JSTRA+1))          pcts(jl, jstra) = 0.
230       4       *(ZTT1(JL,5)*ZTT1(JL,9)*ZTT1(JL,13)        END DO
231       4       - ZTT (JL,5)*ZTT (JL,9)*ZTT (JL,13))      END DO
232       5  +(PB(JL,5,JSTRA)+PB(JL,5,JSTRA+1))    END IF
233       5       *(ZTT1(JL,3)           *ZTT1(JL,14)  
234       5       - ZTT (JL,3)           *ZTT (JL,14))  
235       6  +(PB(JL,6,JSTRA)+PB(JL,6,JSTRA+1))    ! *         2.5     EXCHANGE WITH LOWER LIMIT
236       6       *(ZTT1(JL,6)           *ZTT1(JL,15)    ! -------------------------
237       6       - ZTT (JL,6)           *ZTT (JL,15))  
238          PCTS(JL,JSTRA)=ZCTSTR*0.5  
239   2424   CONTINUE    DO jl = 1, kdlon
240          DO 2426 JA=1,KTRAER      zbgnd(jl) = pbsui(jl)*pemis(jl) - (1.-pemis(jl))*pfluc(jl, 2, 1) - &
241          DO 2425 JL=1, KDLON        pbint(jl, 1)
242          ZTT1(JL,JA)=ZTT(JL,JA)    END DO
243   2425   CONTINUE  
244   2426   CONTINUE    jk = 1
245   2427   CONTINUE    in = (jk-1)*ng1p1 + 1
246        ENDIF  
247  C Mise a zero de securite pour PCTS en cas de LEVOIGT    DO jl = 1, kdlon
248        IF(LEVOIGT)THEN      zcnsol(jl) = pbsur(jl, 1) + pbsur(jl, 2) + pbsur(jl, 3) + pbsur(jl, 4) + &
249          DO 2429 JSTRA = 1,KFLEV        pbsur(jl, 5) + pbsur(jl, 6)
250          DO 2428 JL = 1, KDLON      zcnsol(jl) = zcnsol(jl)*zbgnd(jl)/pbsui(jl)
251            PCTS(JL,JSTRA)=0.      zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
252   2428   CONTINUE      pfluc(jl, 1, jk) = zfu(jl)
253   2429   CONTINUE    END DO
254        ENDIF  
255  C    DO jk = 2, kflev + 1
256  C      in = (jk-1)*ng1p1 + 1
257  C*         2.5     EXCHANGE WITH LOWER LIMIT  
258  C                  -------------------------  
259  C      DO ja = 1, kuaer
260   250  CONTINUE        DO jl = 1, kdlon
261  C          zuu(jl, ja) = pabcu(jl, ja, 1) - pabcu(jl, ja, in)
262        DO 251 JL = 1, KDLON        END DO
263        ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL))      END DO
264       S               *PFLUC(JL,2,1)-PBINT(JL,1)  
265   251  CONTINUE  
266  C      CALL lwtt(pgasur(1,1,1), pgbsur(1,1,1), zuu, ztt)
267        JK = 1  
268        IN=(JK-1)*NG1P1+1      DO jl = 1, kdlon
269  C        zcnsol(jl) = pbsur(jl, 1)*ztt(jl, 1)*ztt(jl, 10) + &
270        DO 252 JL = 1, KDLON          pbsur(jl, 2)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
271        ZCNSOL(JL)=PBSUR(JL,1)          pbsur(jl, 3)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
272       1 +PBSUR(JL,2)          pbsur(jl, 4)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
273       2 +PBSUR(JL,3)          pbsur(jl, 5)*ztt(jl, 3)*ztt(jl, 14) + pbsur(jl, 6)*ztt(jl, 6)*ztt(jl, &
274       3 +PBSUR(JL,4)          15)
275       4 +PBSUR(JL,5)        zcnsol(jl) = zcnsol(jl)*zbgnd(jl)/pbsui(jl)
276       5 +PBSUR(JL,6)        zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
277        ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)        pfluc(jl, 1, jk) = zfu(jl)
278        ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)      END DO
279        PFLUC(JL,1,JK)=ZFU(JL)  
280   252  CONTINUE  
281  C    END DO
282        DO 257 JK = 2 , KFLEV+1  
283        IN=(JK-1)*NG1P1+1  
284  C  
285  C    ! *         2.7     CLEAR-SKY FLUXES
286        DO 255 JA=1,KUAER    ! ----------------
287        DO 254 JL=1, KDLON  
288        ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)  
289   254  CONTINUE    IF (.NOT. levoigt) THEN
290   255  CONTINUE      DO jl = 1, kdlon
291  C        zfn10(jl) = pfluc(jl, 1, jlim) + pfluc(jl, 2, jlim)
292  C      END DO
293        CALL LWTT(PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT)      DO jk = jlim + 1, kflev + 1
294  C        DO jl = 1, kdlon
295        DO 256 JL = 1, KDLON          zfn10(jl) = zfn10(jl) + pcts(jl, jk-1)
296        ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1)          *ZTT(JL,10)          pfluc(jl, 1, jk) = zfn10(jl)
297       2      +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)          pfluc(jl, 2, jk) = 0.
298       3      +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)        END DO
299       4      +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)      END DO
300       5      +PBSUR(JL,5)*ZTT(JL,3)          *ZTT(JL,14)    END IF
301       6      +PBSUR(JL,6)*ZTT(JL,6)          *ZTT(JL,15)  
302        ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)    ! ------------------------------------------------------------------
303        ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)  
304        PFLUC(JL,1,JK)=ZFU(JL)    RETURN
305   256  CONTINUE  END SUBROUTINE lwvb
 C  
 C  
  257  CONTINUE  
 C  
 C  
 C  
 C*         2.7     CLEAR-SKY FLUXES  
 C                  ----------------  
 C  
  270  CONTINUE  
 C  
       IF (.NOT.LEVOIGT) THEN  
       DO 271 JL = 1, KDLON  
       ZFN10(JL) = PFLUC(JL,1,JLIM) + PFLUC(JL,2,JLIM)  
  271  CONTINUE  
       DO 273 JK = JLIM+1,KFLEV+1  
       DO 272 JL = 1, KDLON  
       ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1)  
       PFLUC(JL,1,JK) = ZFN10(JL)  
       PFLUC(JL,2,JK) = 0.  
  272  CONTINUE  
  273  CONTINUE  
       ENDIF  
 C  
 C     ------------------------------------------------------------------  
 C  
       RETURN  
       END  
Legend:
Removed from v.24  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21