/[lmdze]/trunk/phylmd/Radlwsw/lwvb.f90
ViewVC logotype

Diff of /trunk/phylmd/Radlwsw/lwvb.f90

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 254 by guez, Mon Feb 5 10:39:38 2018 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 zuu(kdlon, nua)
78        REAL*8 ZTT1(KDLON,NTRA)    DOUBLE PRECISION zcnsol(kdlon)
79        REAL*8 ZTT2(KDLON,NTRA)    DOUBLE PRECISION zcntop(kdlon)
80        REAL*8  ZUU(KDLON,NUA)  
81        REAL*8 ZCNSOL(KDLON)    INTEGER jk, jl, ja
82        REAL*8 ZCNTOP(KDLON)    INTEGER jstra, jstru
83  C    INTEGER in, jlim
84        INTEGER jk, jl, ja    DOUBLE PRECISION zctstr
85        INTEGER jstra, jstru    ! -----------------------------------------------------------------------
86        INTEGER ind1, ind2, ind3, ind4, in, jlim  
87        REAL*8 zctstr    ! *         1.    INITIALIZATION
88  C-----------------------------------------------------------------------    ! --------------
89  C  
90  C*         1.    INITIALIZATION  
91  C                --------------  
92  C    ! *         1.2     INITIALIZE TRANSMISSION FUNCTIONS
93   100  CONTINUE    ! ---------------------------------
94  C  
95  C  
96  C*         1.2     INITIALIZE TRANSMISSION FUNCTIONS    DO ja = 1, ntra
97  C                  ---------------------------------      DO jl = 1, kdlon
98  C        ztt(jl, ja) = 1.0
99   120  CONTINUE        ztt1(jl, ja) = 1.0
100  C      END DO
101        DO 122 JA=1,NTRA    END DO
102        DO 121 JL=1, KDLON  
103        ZTT (JL,JA)=1.0    DO ja = 1, nua
104        ZTT1(JL,JA)=1.0      DO jl = 1, kdlon
105        ZTT2(JL,JA)=1.0        zuu(jl, ja) = 1.0
106   121  CONTINUE      END DO
107   122  CONTINUE    END DO
108  C  
109        DO 124 JA=1,NUA    ! ------------------------------------------------------------------
110        DO 123 JL=1, KDLON  
111        ZUU(JL,JA)=1.0    ! *         2.      VERTICAL INTEGRATION
112   123  CONTINUE    ! --------------------
113   124  CONTINUE  
114  C    ! *         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
115  C     ------------------------------------------------------------------    ! -----------------------------------
116  C  
117  C*         2.      VERTICAL INTEGRATION  
118  C                  --------------------    DO jk = 1, kflev
119  C      in = (jk-1)*ng1p1 + 1
120   200  CONTINUE  
121  C      DO ja = 1, kuaer
122        IND1=0        DO jl = 1, kdlon
123        IND3=0          zuu(jl, ja) = pabcu(jl, ja, in)
124        IND4=1        END DO
125        IND2=1      END DO
126  C  
127  C  
128  C*         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE      CALL lwtt(pgatop(1,1,1), pgbtop(1,1,1), zuu, ztt)
129  C                  -----------------------------------  
130  C      DO jl = 1, kdlon
131   230  CONTINUE        zcntop(jl) = pbtop(jl, 1)*ztt(jl, 1)*ztt(jl, 10) + &
132  C          pbtop(jl, 2)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
133        DO 235 JK = 1 , KFLEV          pbtop(jl, 3)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
134        IN=(JK-1)*NG1P1+1          pbtop(jl, 4)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
135  C          pbtop(jl, 5)*ztt(jl, 3)*ztt(jl, 14) + pbtop(jl, 6)*ztt(jl, 6)*ztt(jl, &
136        DO 232 JA=1,KUAER          15)
137        DO 231 JL=1, KDLON        zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
138        ZUU(JL,JA)=PABCU(JL,JA,IN)        pfluc(jl, 2, jk) = zfd(jl)
139   231  CONTINUE      END DO
140   232  CONTINUE  
141  C    END DO
142  C  
143        CALL LWTT(PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT)    jk = kflev + 1
144  C    in = (jk-1)*ng1p1 + 1
145        DO 234 JL = 1, KDLON  
146        ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1)          *ZTT(JL,10)    DO jl = 1, kdlon
147       2      +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)      zcntop(jl) = pbtop(jl, 1) + pbtop(jl, 2) + pbtop(jl, 3) + pbtop(jl, 4) + &
148       3      +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)        pbtop(jl, 5) + pbtop(jl, 6)
149       4      +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)      zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
150       5      +PBTOP(JL,5)*ZTT(JL,3)          *ZTT(JL,14)      pfluc(jl, 2, jk) = zfd(jl)
151       6      +PBTOP(JL,6)*ZTT(JL,6)          *ZTT(JL,15)    END DO
152        ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)  
153        PFLUC(JL,2,JK)=ZFD(JL)    ! *         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
154   234  CONTINUE    ! ---------------------------------------
155  C  
156   235  CONTINUE  
157  C  
158        JK = KFLEV+1    ! *         2.4.1   INITIALIZATION
159        IN=(JK-1)*NG1P1+1    ! --------------
160  C  
161        DO 236 JL = 1, KDLON  
162        ZCNTOP(JL)= PBTOP(JL,1)    jlim = kflev
163       1   + PBTOP(JL,2)  
164       2   + PBTOP(JL,3)    IF (.NOT. levoigt) THEN
165       3   + PBTOP(JL,4)      DO jk = kflev, 1, -1
166       4   + PBTOP(JL,5)        IF (ppmb(1,jk)<10.0) THEN
167       5   + PBTOP(JL,6)          jlim = jk
168        ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)        END IF
169        PFLUC(JL,2,JK)=ZFD(JL)      END DO
170   236  CONTINUE    END IF
171  C    klim = jlim
172  C*         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA  
173  C                  ---------------------------------------    IF (.NOT. levoigt) THEN
174  C      DO ja = 1, ktraer
175   240  CONTINUE        DO jl = 1, kdlon
176  C          ztt1(jl, ja) = 1.0
177  C        END DO
178  C*         2.4.1   INITIALIZATION      END DO
179  C                  --------------  
180  C      ! *         2.4.2   LOOP OVER LAYERS ABOVE 10 HPA
181   2410 CONTINUE      ! -----------------------------
182  C  
183        JLIM = KFLEV  
184  C      DO jstra = kflev, jlim, -1
185        IF (.NOT.LEVOIGT) THEN        jstru = (jstra-1)*ng1p1 + 1
186        DO 2412 JK = KFLEV,1,-1  
187        IF(PPMB(1,JK).LT.10.0) THEN        DO ja = 1, kuaer
188           JLIM=JK          DO jl = 1, kdlon
189        ENDIF              zuu(jl, ja) = pabcu(jl, ja, jstru)
190   2412 CONTINUE          END DO
191        ENDIF        END DO
192        KLIM=JLIM  
193  C  
194        IF (.NOT.LEVOIGT) THEN        CALL lwtt(pga(1,1,1,jstra), pgb(1,1,1,jstra), zuu, ztt)
195          DO 2414 JA=1,KTRAER  
196          DO 2413 JL=1, KDLON        DO jl = 1, kdlon
197          ZTT1(JL,JA)=1.0          zctstr = (pb(jl,1,jstra)+pb(jl,1,jstra+1))* &
198   2413   CONTINUE            (ztt1(jl,1)*ztt1(jl,10)-ztt(jl,1)*ztt(jl,10)) + &
199   2414   CONTINUE            (pb(jl,2,jstra)+pb(jl,2,jstra+1))*(ztt1(jl,2)*ztt1(jl,7)*ztt1(jl,11 &
200  C            )-ztt(jl,2)*ztt(jl,7)*ztt(jl,11)) + (pb(jl,3,jstra)+pb(jl,3,jstra+1 &
201  C*         2.4.2   LOOP OVER LAYERS ABOVE 10 HPA            ))*(ztt1(jl,4)*ztt1(jl,8)*ztt1(jl,12)-ztt(jl,4)*ztt(jl,8)*ztt(jl,12 &
202  C                  -----------------------------            )) + (pb(jl,4,jstra)+pb(jl,4,jstra+1))*(ztt1(jl,5)*ztt1(jl,9)*ztt1( &
203  C            jl,13)-ztt(jl,5)*ztt(jl,9)*ztt(jl,13)) + (pb(jl,5,jstra)+pb(jl,5, &
204   2420   CONTINUE            jstra+1))*(ztt1(jl,3)*ztt1(jl,14)-ztt(jl,3)*ztt(jl,14)) + &
205  C            (pb(jl,6,jstra)+pb(jl,6,jstra+1))*(ztt1(jl,6)*ztt1(jl,15)-ztt(jl,6) &
206          DO 2427 JSTRA = KFLEV,JLIM,-1            *ztt(jl,15))
207          JSTRU=(JSTRA-1)*NG1P1+1          pcts(jl, jstra) = zctstr*0.5
208  C        END DO
209          DO 2423 JA=1,KUAER        DO ja = 1, ktraer
210          DO 2422 JL=1, KDLON          DO jl = 1, kdlon
211          ZUU(JL,JA)=PABCU(JL,JA,JSTRU)            ztt1(jl, ja) = ztt(jl, ja)
212   2422   CONTINUE          END DO
213   2423   CONTINUE        END DO
214  C      END DO
215  C    END IF
216          CALL LWTT(PGA(1,1,1,JSTRA), PGB(1,1,1,JSTRA), ZUU, ZTT)    ! Mise a zero de securite pour PCTS en cas de LEVOIGT
217  C    IF (levoigt) THEN
218          DO 2424 JL = 1, KDLON      DO jstra = 1, kflev
219          ZCTSTR =        DO jl = 1, kdlon
220       1   (PB(JL,1,JSTRA)+PB(JL,1,JSTRA+1))          pcts(jl, jstra) = 0.
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 IF
224       2       *(ZTT1(JL,2)*ZTT1(JL,7)*ZTT1(JL,11)  
225       2       - ZTT (JL,2)*ZTT (JL,7)*ZTT (JL,11))  
226       3  +(PB(JL,3,JSTRA)+PB(JL,3,JSTRA+1))    ! *         2.5     EXCHANGE WITH LOWER LIMIT
227       3       *(ZTT1(JL,4)*ZTT1(JL,8)*ZTT1(JL,12)    ! -------------------------
228       3       - ZTT (JL,4)*ZTT (JL,8)*ZTT (JL,12))  
229       4  +(PB(JL,4,JSTRA)+PB(JL,4,JSTRA+1))  
230       4       *(ZTT1(JL,5)*ZTT1(JL,9)*ZTT1(JL,13)    DO jl = 1, kdlon
231       4       - ZTT (JL,5)*ZTT (JL,9)*ZTT (JL,13))      zbgnd(jl) = pbsui(jl)*pemis(jl) - (1.-pemis(jl))*pfluc(jl, 2, 1) - &
232       5  +(PB(JL,5,JSTRA)+PB(JL,5,JSTRA+1))        pbint(jl, 1)
233       5       *(ZTT1(JL,3)           *ZTT1(JL,14)    END DO
234       5       - ZTT (JL,3)           *ZTT (JL,14))  
235       6  +(PB(JL,6,JSTRA)+PB(JL,6,JSTRA+1))    jk = 1
236       6       *(ZTT1(JL,6)           *ZTT1(JL,15)    in = (jk-1)*ng1p1 + 1
237       6       - ZTT (JL,6)           *ZTT (JL,15))  
238          PCTS(JL,JSTRA)=ZCTSTR*0.5    DO jl = 1, kdlon
239   2424   CONTINUE      zcnsol(jl) = pbsur(jl, 1) + pbsur(jl, 2) + pbsur(jl, 3) + pbsur(jl, 4) + &
240          DO 2426 JA=1,KTRAER        pbsur(jl, 5) + pbsur(jl, 6)
241          DO 2425 JL=1, KDLON      zcnsol(jl) = zcnsol(jl)*zbgnd(jl)/pbsui(jl)
242          ZTT1(JL,JA)=ZTT(JL,JA)      zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
243   2425   CONTINUE      pfluc(jl, 1, jk) = zfu(jl)
244   2426   CONTINUE    END DO
245   2427   CONTINUE  
246        ENDIF    DO jk = 2, kflev + 1
247  C Mise a zero de securite pour PCTS en cas de LEVOIGT      in = (jk-1)*ng1p1 + 1
248        IF(LEVOIGT)THEN  
249          DO 2429 JSTRA = 1,KFLEV  
250          DO 2428 JL = 1, KDLON      DO ja = 1, kuaer
251            PCTS(JL,JSTRA)=0.        DO jl = 1, kdlon
252   2428   CONTINUE          zuu(jl, ja) = pabcu(jl, ja, 1) - pabcu(jl, ja, in)
253   2429   CONTINUE        END DO
254        ENDIF      END DO
255  C  
256  C  
257  C*         2.5     EXCHANGE WITH LOWER LIMIT      CALL lwtt(pgasur(1,1,1), pgbsur(1,1,1), zuu, ztt)
258  C                  -------------------------  
259  C      DO jl = 1, kdlon
260   250  CONTINUE        zcnsol(jl) = pbsur(jl, 1)*ztt(jl, 1)*ztt(jl, 10) + &
261  C          pbsur(jl, 2)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
262        DO 251 JL = 1, KDLON          pbsur(jl, 3)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
263        ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL))          pbsur(jl, 4)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
264       S               *PFLUC(JL,2,1)-PBINT(JL,1)          pbsur(jl, 5)*ztt(jl, 3)*ztt(jl, 14) + pbsur(jl, 6)*ztt(jl, 6)*ztt(jl, &
265   251  CONTINUE          15)
266  C        zcnsol(jl) = zcnsol(jl)*zbgnd(jl)/pbsui(jl)
267        JK = 1        zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
268        IN=(JK-1)*NG1P1+1        pfluc(jl, 1, jk) = zfu(jl)
269  C      END DO
270        DO 252 JL = 1, KDLON  
271        ZCNSOL(JL)=PBSUR(JL,1)  
272       1 +PBSUR(JL,2)    END DO
273       2 +PBSUR(JL,3)  
274       3 +PBSUR(JL,4)  
275       4 +PBSUR(JL,5)  
276       5 +PBSUR(JL,6)    ! *         2.7     CLEAR-SKY FLUXES
277        ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)    ! ----------------
278        ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)  
279        PFLUC(JL,1,JK)=ZFU(JL)  
280   252  CONTINUE    IF (.NOT. levoigt) THEN
281  C      DO jl = 1, kdlon
282        DO 257 JK = 2 , KFLEV+1        zfn10(jl) = pfluc(jl, 1, jlim) + pfluc(jl, 2, jlim)
283        IN=(JK-1)*NG1P1+1      END DO
284  C      DO jk = jlim + 1, kflev + 1
285  C        DO jl = 1, kdlon
286        DO 255 JA=1,KUAER          zfn10(jl) = zfn10(jl) + pcts(jl, jk-1)
287        DO 254 JL=1, KDLON          pfluc(jl, 1, jk) = zfn10(jl)
288        ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)          pfluc(jl, 2, jk) = 0.
289   254  CONTINUE        END DO
290   255  CONTINUE      END DO
291  C    END IF
292  C  
293        CALL LWTT(PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT)    ! ------------------------------------------------------------------
294  C  
295        DO 256 JL = 1, KDLON    RETURN
296        ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1)          *ZTT(JL,10)  END SUBROUTINE lwvb
      2      +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)  
      3      +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)  
      4      +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)  
      5      +PBSUR(JL,5)*ZTT(JL,3)          *ZTT(JL,14)  
      6      +PBSUR(JL,6)*ZTT(JL,6)          *ZTT(JL,15)  
       ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)  
       ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)  
       PFLUC(JL,1,JK)=ZFU(JL)  
  256  CONTINUE  
 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.254
  ViewVC Help
Powered by ViewVC 1.1.21