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

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

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

revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC 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        DOUBLE PRECISION PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS    DOUBLE PRECISION padju(kdlon, kflev+1) ! CONTRIBUTION BY ADJACENT LAYERS
50        DOUBLE PRECISION PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS    DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
51        DOUBLE PRECISION PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS    DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
52        DOUBLE PRECISION PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS    DOUBLE PRECISION pbsur(kdlon, ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
53        DOUBLE PRECISION PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS    DOUBLE PRECISION pbsui(kdlon) ! SURFACE PLANCK FUNCTION
54        DOUBLE PRECISION PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION    DOUBLE PRECISION pbtop(kdlon, ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
55        DOUBLE PRECISION PBSUI(KDLON) ! SURFACE PLANCK FUNCTION    DOUBLE PRECISION pdisd(kdlon, kflev+1) ! CONTRIBUTION BY DISTANT LAYERS
56        DOUBLE PRECISION PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION    DOUBLE PRECISION pdisu(kdlon, kflev+1) ! CONTRIBUTION BY DISTANT LAYERS
57        DOUBLE PRECISION PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS    DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY
58        DOUBLE PRECISION PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS    DOUBLE PRECISION ppmb(kdlon, kflev+1) ! PRESSURE MB
59        DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY    DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
60        DOUBLE PRECISION PPMB(KDLON,KFLEV+1) ! PRESSURE MB    DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
61        DOUBLE PRECISION PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS    DOUBLE PRECISION pgasur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
62        DOUBLE PRECISION PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS    DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
63        DOUBLE PRECISION PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS    DOUBLE PRECISION pgatop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
64        DOUBLE PRECISION PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS    DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
65        DOUBLE PRECISION PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS  
66        DOUBLE PRECISION 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        DOUBLE PRECISION PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES  
69        DOUBLE PRECISION 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        DOUBLE PRECISION ZBGND(KDLON)    DOUBLE PRECISION zfn10(kdlon)
74        DOUBLE PRECISION ZFD(KDLON)    DOUBLE PRECISION zfu(kdlon)
75        DOUBLE PRECISION  ZFN10(KDLON)    DOUBLE PRECISION ztt(kdlon, ntra)
76        DOUBLE PRECISION ZFU(KDLON)    DOUBLE PRECISION ztt1(kdlon, ntra)
77        DOUBLE PRECISION  ZTT(KDLON,NTRA)    DOUBLE PRECISION zuu(kdlon, nua)
78        DOUBLE PRECISION ZTT1(KDLON,NTRA)    DOUBLE PRECISION zcnsol(kdlon)
79        DOUBLE PRECISION ZTT2(KDLON,NTRA)    DOUBLE PRECISION zcntop(kdlon)
80        DOUBLE PRECISION  ZUU(KDLON,NUA)  
81        DOUBLE PRECISION ZCNSOL(KDLON)    INTEGER jk, jl, ja
82        DOUBLE PRECISION 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        DOUBLE PRECISION 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.76  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21