source: LMDZ5/trunk/libf/phymar/swni.F90 @ 2654

Last change on this file since 2654 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR


Integration of MAR physics

File size: 14.4 KB
Line 
1SUBROUTINE SWNI &
2 &( KIDIA , KFDIA , KLON  , KLEV , KAER  , KNU &
3 &, PAER  , PAKI  , PALBD , PALBP, PCG   , PCLD, PCLEAR &
4 &, PDSIG , POMEGA, POZ   , PRMU , PSEC  , PTAU &
5 &, PUD   , PWV   , PQS &
6 &, PFDOWN, PFUP  , PCDOWN, PCUP , PSUDU2 &
7 &)
8
9!**** *SWNI* - SHORTWAVE RADIATION, NEAR-INFRARED SPECTRAL INTERVALS
10
11!     PURPOSE.
12!     --------
13
14!          COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE NEAR-INFRARED
15!     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
16
17!**   INTERFACE.
18!     ----------
19
20!          *SWNI* IS CALLED FROM *SW*.
21
22
23!        IMPLICIT ARGUMENTS :
24!        --------------------
25
26!     ==== INPUTS ===
27!     ==== OUTPUTS ===
28
29!     METHOD.
30!     -------
31
32!          1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO
33!     CONTINUUM SCATTERING
34!          2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR
35!     A GREY MOLECULAR ABSORPTION
36!          3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS
37!     OF ABSORBERS
38!          4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS
39!          5. MULTIPLY BY OZONE TRANSMISSION FUNCTION
40
41!     EXTERNALS.
42!     ----------
43
44!          *SWCLR*, *SWR*, *SWDE*, *SWTT*
45
46!     REFERENCE.
47!     ----------
48
49!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
50!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
51
52!     AUTHOR.
53!     -------
54!        JEAN-JACQUES MORCRETTE  *ECMWF*
55
56!     MODIFICATIONS.
57!     --------------
58!        ORIGINAL : 89-07-14
59!        94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
60!        95-12-07   J.-J. MORCRETTE    NEAR-INFRARED SW
61!        990128     JJMorcrette        Sunshine duration
62!        99-05-25   JJMorcrette        Revised aerosols
63
64!     ------------------------------------------------------------------
65
66
67#include "tsmbkind.h"
68
69USE YOESW    , ONLY : RRAY     ,RSUN     ,RSWCE    ,RSWCP
70USE YOERAD   , ONLY : NSW
71USE YOERDU   , ONLY : REPLOG
72
73
74IMPLICIT NONE
75
76
77!     DUMMY INTEGER SCALARS
78INTEGER_M :: KAER
79INTEGER_M :: KFDIA
80INTEGER_M :: KIDIA
81INTEGER_M :: KKIND
82INTEGER_M :: KLEV
83INTEGER_M :: KLON
84INTEGER_M :: KNU
85
86
87
88
89!#include "yoeaer.h"
90!     ------------------------------------------------------------------
91
92!*       0.1   ARGUMENTS
93!              ---------
94
95REAL_B :: PAER(KLON,6,KLEV)    , PAKI(KLON,2,NSW)&
96  &,  PALBD(KLON,NSW)      , PALBP(KLON,NSW)&
97  &,  PCG(KLON,NSW,KLEV)   , PCLD(KLON,KLEV)&
98  &,  PCLEAR(KLON)         , PDSIG(KLON,KLEV)&
99  &,  POMEGA(KLON,NSW,KLEV), POZ(KLON,KLEV)&
100  &,  PQS(KLON,KLEV)&
101  &,  PRMU(KLON)           , PSEC(KLON)&
102  &,  PTAU(KLON,NSW,KLEV)  , PUD(KLON,5,KLEV+1)&
103  &,  PWV(KLON,KLEV)
104
105REAL_B :: PFDOWN(KLON,KLEV+1)  , PFUP(KLON,KLEV+1)&
106  &,  PCDOWN(KLON,KLEV+1)  , PCUP(KLON,KLEV+1)&
107  &,  PSUDU2(KLON)
108
109!     ------------------------------------------------------------------
110
111!*       0.2   LOCAL ARRAYS
112!              ------------
113
114INTEGER_M :: IIND2(2), IIND3(3)
115REAL_B :: ZCGAZ(KLON,KLEV)  , ZDIFF(KLON)         , ZDIRF(KLON)&
116  &,  ZFD(KLON,KLEV+1)  , ZFU(KLON,KLEV+1) &
117  &,  ZG(KLON)          , ZGG(KLON)
118REAL_B :: ZPIZAZ(KLON,KLEV)&
119  &,  ZRAYL(KLON)       , ZRAY1(KLON,KLEV+1)  , ZRAY2(KLON,KLEV+1)&
120  &,  ZREF(KLON)        , ZREFZ(KLON,2,KLEV+1)&
121  &,  ZRE1(KLON)        , ZRE2(KLON)&
122  &,  ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)&
123  &,  ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)&
124  &,  ZRL(KLON,8)&
125  &,  ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1)  , ZRMUZ(KLON)&
126  &,  ZRNEB(KLON)       , ZRUEF(KLON,8)       , ZR1(KLON) &
127  &,  ZR2(KLON,2)       , ZR3(KLON,3)         , ZR4(KLON)&
128  &,  ZR21(KLON)        , ZR22(KLON)
129REAL_B :: ZS(KLON)&
130  &,  ZTAUAZ(KLON,KLEV) , ZTO1(KLON)          , ZTR(KLON,2,KLEV+1)&
131  &,  ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)&
132  &,  ZTRCLD(KLON)      , ZTRCLR(KLON)&
133  &,  ZTR1(KLON)        , ZTR2(KLON)&
134  &,  ZW(KLON)          , ZW1(KLON)           , ZW2(KLON,2)&
135  &,  ZW3(KLON,3)       , ZW4(KLON)           , ZW5(KLON)
136
137!     LOCAL INTEGER SCALARS
138INTEGER_M :: IABS, IKL, IKM1, JABS, JAJ, JAJP, JK, JKKI,&
139             &JKKP4, JKL, JKLP1, JKM1, JL, JN, JN2J, JREF
140
141!     LOCAL REAL SCALARS
142REAL_B :: ZAA, ZBB, ZCNEB, ZRE11, ZRKI, ZRMUM1, ZWH2O
143
144
145!     ------------------------------------------------------------------
146
147!*         1.     NEAR-INFRARED SPECTRAL INTERVAL (0.68-4.00 MICRON)
148!                 --------------------------------------------------
149
150
151
152!*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
153!                 -----------------------------------------
154
155
156DO JL = KIDIA,KFDIA
157  ZRMUM1 = _ONE_ - PRMU(JL)
158  ZRAYL(JL) =  RRAY(KNU,1) + ZRMUM1   * (RRAY(KNU,2) + ZRMUM1 &
159   &* (RRAY(KNU,3) + ZRMUM1   * (RRAY(KNU,4) + ZRMUM1 &
160   &* (RRAY(KNU,5) + ZRMUM1   *  RRAY(KNU,6)     ))))
161ENDDO
162
163
164!     ------------------------------------------------------------------
165
166!*         2.    CONTINUUM SCATTERING CALCULATIONS
167!                ---------------------------------
168
169
170!*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
171!                --------------------------------
172
173
174CALL SWCLR &
175  &( KIDIA , KFDIA , KLON ,  KLEV , KAER , KNU &
176  &, PAER  , PALBP , PDSIG , ZRAYL, PSEC &
177  &, ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 &
178  &, ZRK0  , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR &
179  &)
180
181
182!*         2.2   CLOUDY FRACTION OF THE COLUMN
183!                -----------------------------
184
185
186CALL SWR &
187  &( KIDIA , KFDIA , KLON , KLEV  , KNU &
188  &, PALBD , PCG   , PCLD , POMEGA, PSEC , PTAU &
189  &, ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2 , ZREFZ, ZRJ  , ZRK, ZRMUE &
190  &, ZTAUAZ, ZTRA1 , ZTRA2, ZTRCLD &
191  &)
192
193
194!     ------------------------------------------------------------------
195
196!*         3.    SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION
197!                ------------------------------------------------------
198
199
200JN = 2
201
202DO JABS=1,2
203
204
205!*         3.1  SURFACE CONDITIONS
206!               ------------------
207
208
209  DO JL = KIDIA,KFDIA
210    ZREFZ(JL,2,1) = PALBD(JL,KNU)
211    ZREFZ(JL,1,1) = PALBD(JL,KNU)
212  ENDDO
213
214
215!*         3.2  INTRODUCING CLOUD EFFECTS
216!               -------------------------
217
218
219  DO JK = 2 , KLEV+1
220    JKM1 = JK - 1
221    IKL=KLEV+1-JKM1
222    DO JL = KIDIA,KFDIA
223      ZRNEB(JL) = PCLD(JL,JKM1)
224      IF (JABS == 1.AND. ZRNEB(JL) > _TWO_*REPLOG) THEN
225        ZWH2O=MAX(PWV(JL,IKL),REPLOG)
226        ZCNEB=MAX(REPLOG,MIN(ZRNEB(JL),_ONE_-REPLOG))
227        ZBB=PUD(JL,JABS,JKM1)*PQS(JL,IKL)/ZWH2O
228        ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(_ONE_-ZCNEB),REPLOG)
229!-- just to test Box-type computations
230!        ZAA=PUD(JL,JABS,JKM1)
231!        ZBB=ZAA
232      ELSE
233        ZAA=PUD(JL,JABS,JKM1)
234        ZBB=ZAA
235      ENDIF
236      ZRKI = PAKI(JL,JABS,KNU)
237      ZS(JL) = EXP(-ZRKI * ZAA * 1.66_JPRB)
238      ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK))
239      ZTR1(JL) = _ZERO_
240      ZRE1(JL) = _ZERO_
241      ZTR2(JL) = _ZERO_
242      ZRE2(JL) = _ZERO_
243
244      ZW(JL)= POMEGA(JL,KNU,JKM1)
245      ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL)&
246       &+ ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)&
247       &+ ZBB * ZRKI
248
249      ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1)
250      ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
251      ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)&
252       &+ (_ONE_ - ZR22(JL)) * ZCGAZ(JL,JKM1)
253      ZW(JL) = ZR21(JL) / ZTO1(JL)
254      ZREF(JL) = ZREFZ(JL,1,JKM1)
255      ZRMUZ(JL) = ZRMUE(JL,JK)
256    ENDDO
257
258    CALL SWDE ( KIDIA, KFDIA, KLON &
259     &, ZGG  , ZREF , ZRMUZ, ZTO1, ZW &
260     &, ZRE1 , ZRE2 , ZTR1 , ZTR2     )
261
262    DO JL = KIDIA,KFDIA
263
264      ZREFZ(JL,2,JK) = (_ONE_-ZRNEB(JL)) * (ZRAY1(JL,JKM1)&
265       &+ ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)&
266       &* ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL)&
267       &+ ZRNEB(JL) * ZRE1(JL)
268
269      ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL)&
270       &+ (ZTRA1(JL,JKM1)) * ZG(JL) * (_ONE_-ZRNEB(JL))
271
272      ZREFZ(JL,1,JK)=(_ONE_-ZRNEB(JL))*(ZRAY1(JL,JKM1)&
273       &+ZREFZ(JL,1,JKM1)*ZTRA1(JL,JKM1)*ZTRA2(JL,JKM1)&
274       &/(_ONE_-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))*ZG(JL)*ZS(JL)&
275       &+ ZRNEB(JL) * ZRE2(JL)
276
277      ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL)&
278       &+ (ZTRA1(JL,JKM1)/(_ONE_-ZRAY2(JL,JKM1)&
279       &* ZREFZ(JL,1,JKM1)))&
280       &* ZG(JL) * (_ONE_ -ZRNEB(JL))
281
282    ENDDO
283  ENDDO
284
285!*         3.3  REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
286!               -------------------------------------------------
287
288
289  DO JREF=1,2
290
291    JN = JN + 1
292
293    DO JL = KIDIA,KFDIA
294      ZRJ(JL,JN,KLEV+1) = _ONE_
295      ZRK(JL,JN,KLEV+1) = ZREFZ(JL,JREF,KLEV+1)
296    ENDDO
297
298    DO JK = 1 , KLEV
299      JKL = KLEV+1 - JK
300      JKLP1 = JKL + 1
301      DO JL = KIDIA,KFDIA
302        ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL)
303        ZRJ(JL,JN,JKL) = ZRE11
304        ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL)
305      ENDDO
306    ENDDO
307  ENDDO
308ENDDO
309
310
311!     ------------------------------------------------------------------
312
313!*         4.    INVERT GREY AND CONTINUUM FLUXES
314!                --------------------------------
315
316
317
318!*         4.1   UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES
319!                ---------------------------------------------
320
321
322DO JK = 1 , KLEV+1
323  DO JAJ = 1 , 5 , 2
324    JAJP = JAJ + 1
325    DO JL = KIDIA,KFDIA
326      ZRJ(JL,JAJ,JK)=        ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK)
327      ZRK(JL,JAJ,JK)=        ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK)
328      ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , REPLOG )
329      ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , REPLOG )
330    ENDDO
331  ENDDO
332ENDDO
333
334DO JK = 1 , KLEV+1
335  DO JAJ = 2 , 6 , 2
336    DO JL = KIDIA,KFDIA
337      ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , REPLOG )
338      ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , REPLOG )
339    ENDDO
340  ENDDO
341ENDDO
342
343!*         4.2    EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE
344!                 ---------------------------------------------
345
346
347DO JK = 1 , KLEV+1
348  JKKI = 1
349  DO JAJ = 1 , 2
350    IIND2(1)=JAJ
351    IIND2(2)=JAJ
352    DO JN = 1 , 2
353      JN2J = JN + 2 * JAJ
354      JKKP4 = JKKI + 4
355
356!*         4.2.1  EFFECTIVE ABSORBER AMOUNTS
357!                 --------------------------
358
359
360      DO JL = KIDIA,KFDIA
361        ZW2(JL,1) = LOG( ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK))/ PAKI(JL,JAJ,KNU)
362        ZW2(JL,2) = LOG( ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK))/ PAKI(JL,JAJ,KNU)
363      ENDDO
364
365!*         4.2.2  TRANSMISSION FUNCTION
366!                 ---------------------
367
368
369      KKIND=2
370      CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, KKIND, IIND2 &
371       &, ZW2 &
372       &, ZR2                              )
373
374      DO JL = KIDIA,KFDIA
375        ZRL(JL,JKKI) = ZR2(JL,1)
376        ZRUEF(JL,JKKI) = ZW2(JL,1)
377        ZRL(JL,JKKP4) = ZR2(JL,2)
378        ZRUEF(JL,JKKP4) = ZW2(JL,2)
379      ENDDO
380
381      JKKI=JKKI+1
382    ENDDO
383  ENDDO
384
385!*         4.3    UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION
386!                 ------------------------------------------------------
387
388
389  DO JL = KIDIA,KFDIA
390    PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3)&
391     &+ ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4)
392    PFUP(JL,JK)   = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7)&
393     &+ ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8)
394  ENDDO
395ENDDO
396
397
398!     ------------------------------------------------------------------
399
400!*         5.    MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES
401!                ----------------------------------------
402
403
404
405!*         5.1   DOWNWARD FLUXES
406!                ---------------
407
408
409JAJ = 2
410IIND3(1)=1
411IIND3(2)=2
412IIND3(3)=3
413
414DO JL = KIDIA,KFDIA
415  ZW3(JL,1)=_ZERO_
416  ZW3(JL,2)=_ZERO_
417  ZW3(JL,3)=_ZERO_
418  ZW4(JL)  =_ZERO_
419  ZW5(JL)  =_ZERO_
420  ZR4(JL)  =_ONE_
421  ZFD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1)
422ENDDO
423DO JK = 1 , KLEV
424  IKL = KLEV+1-JK
425  DO JL = KIDIA,KFDIA
426    ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
427    ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
428    ZW3(JL,3)=ZW3(JL,3)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
429    ZW4(JL)  =ZW4(JL)  +PUD(JL,4,IKL)/ZRMU0(JL,IKL)
430    ZW5(JL)  =ZW5(JL)  +PUD(JL,5,IKL)/ZRMU0(JL,IKL)
431  ENDDO
432
433  CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 3, IIND3 &
434   &, ZW3 &
435   &, ZR3                              )
436
437  DO JL = KIDIA,KFDIA
438    ZR4(JL) = EXP(-RSWCE(KNU)*ZW4(JL)-RSWCP(KNU)*ZW5(JL))
439    ZFD(JL,IKL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL)* ZRJ0(JL,JAJ,IKL)
440  ENDDO
441ENDDO
442
443DO JL=KIDIA,KFDIA
444  ZDIFF(JL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL)*ZTRCLD(JL)
445  ZDIRF(JL) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL)*ZTRCLR(JL)
446  PSUDU2(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)&
447   &+PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU)
448ENDDO
449
450
451!*         5.2   UPWARD FLUXES
452!                -------------
453
454
455DO JL = KIDIA,KFDIA
456  ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU)
457ENDDO
458
459DO JK = 2 , KLEV+1
460  IKM1=JK-1
461  DO JL = KIDIA,KFDIA
462    ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
463    ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
464    ZW3(JL,3)=ZW3(JL,3)+POZ(JL,  IKM1)*1.66_JPRB
465    ZW4(JL)  =ZW4(JL)  +PUD(JL,4,IKM1)*1.66_JPRB
466    ZW5(JL)  =ZW5(JL)  +PUD(JL,5,IKM1)*1.66_JPRB
467  ENDDO
468
469  CALL SWTT1 ( KIDIA,KFDIA,KLON, KNU, 3, IIND3 &
470   &, ZW3 &
471   &, ZR3                              )
472
473  DO JL = KIDIA,KFDIA
474    ZR4(JL) = EXP(-RSWCE(KNU)*ZW4(JL)-RSWCP(KNU)*ZW5(JL))
475    ZFU(JL,JK) = ZR3(JL,1)*ZR3(JL,2)*ZR3(JL,3)*ZR4(JL)* ZRK0(JL,JAJ,JK)
476  ENDDO
477ENDDO
478
479
480!     ------------------------------------------------------------------
481
482!*         6.     INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION
483!                 --------------------------------------------------
484
485IABS=3
486
487!*         6.1    DOWNWARD FLUXES
488!                 ---------------
489
490DO JL = KIDIA,KFDIA
491  ZW1(JL)=_ZERO_
492  ZW4(JL)=_ZERO_
493  ZW5(JL)=_ZERO_
494  ZR1(JL)=_ZERO_
495  PFDOWN(JL,KLEV+1) = ((_ONE_-PCLEAR(JL))*PFDOWN(JL,KLEV+1)&
496   &+ PCLEAR(JL) * ZFD(JL,KLEV+1)) * RSUN(KNU)
497  PCDOWN(JL,KLEV+1) = ZFD(JL,KLEV+1) * RSUN(KNU)
498ENDDO
499
500DO JK = 1 , KLEV
501  IKL=KLEV+1-JK
502  DO JL = KIDIA,KFDIA
503    ZW1(JL) = ZW1(JL)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
504    ZW4(JL) = ZW4(JL)+PUD(JL,4,IKL)/ZRMUE(JL,IKL)
505    ZW5(JL) = ZW5(JL)+PUD(JL,5,IKL)/ZRMUE(JL,IKL)
506    ZR4(JL) = EXP(-RSWCE(KNU)*ZW4(JL)-RSWCP(KNU)*ZW5(JL))
507  ENDDO
508
509  CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 )
510
511  DO JL = KIDIA,KFDIA
512    PFDOWN(JL,IKL) = ((_ONE_-PCLEAR(JL))*ZR1(JL)*ZR4(JL)*PFDOWN(JL,&
513     &IKL)&
514     &+PCLEAR(JL)*ZFD(JL,IKL)) * RSUN(KNU)
515    PCDOWN(JL,IKL) = ZFD(JL,IKL) * RSUN(KNU)
516  ENDDO
517ENDDO
518
519
520
521!*         6.2    UPWARD FLUXES
522!                 -------------
523
524DO JL = KIDIA,KFDIA
525  PFUP(JL,1) = ((_ONE_-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,1)&
526   &+PCLEAR(JL)*ZFU(JL,1)) * RSUN(KNU)
527  PCUP(JL,1) = ZFU(JL,1) * RSUN(KNU)
528ENDDO
529
530DO JK = 2 , KLEV+1
531  IKM1=JK-1
532  DO JL = KIDIA,KFDIA
533    ZW1(JL) = ZW1(JL)+POZ(JL  ,IKM1)*1.66_JPRB
534    ZW4(JL) = ZW4(JL)+PUD(JL,4,IKM1)*1.66_JPRB
535    ZW5(JL) = ZW5(JL)+PUD(JL,5,IKM1)*1.66_JPRB
536    ZR4(JL) = EXP(-RSWCE(KNU)*ZW4(JL)-RSWCP(KNU)*ZW5(JL))
537  ENDDO
538
539  CALL SWTT ( KIDIA,KFDIA,KLON, KNU, IABS, ZW1, ZR1 )
540
541  DO JL = KIDIA,KFDIA
542    PFUP(JL,JK) = ((_ONE_-PCLEAR(JL))*ZR1(JL)*ZR4(JL) * PFUP(JL,JK)&
543     &+PCLEAR(JL)*ZFU(JL,JK)) * RSUN(KNU)
544    PCUP(JL,JK) = ZFU(JL,JK) * RSUN(KNU)
545  ENDDO
546ENDDO
547
548!     ------------------------------------------------------------------
549
550RETURN
551END SUBROUTINE SWNI
Note: See TracBrowser for help on using the repository browser.