source: LMDZ5/trunk/libf/phymar/sw2s.F90 @ 5416

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

Inclusion de la physique de MAR

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