source: LMDZ5/trunk/libf/phylmd/rrtm/swclr.F90 @ 2003

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

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets
directs et indirects que l'ancienne version du rayonnement.
OB

New RRTM version that includes the effects of aerosols and outputs the same direct and indirect effects
diagnostics as the old version
OB
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 15.0 KB
Line 
1SUBROUTINE SWCLR &
2 & ( KIDIA , KFDIA , KLON  , KLEV  , KAER  , KNU,&
3 & PAER  , PALBP , PDSIG , PRAYL , PSEC,&
4 & PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ,&
5 & PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR, &
6!++MODIFCODE
7  & LDDUST,PPIZA_DST, PCGA_DST, PTAU_DST )
8!--MODIFCODE
9
10!**** *SWCLR* - CLEAR-SKY COLUMN COMPUTATIONS
11
12!     PURPOSE.
13!     --------
14!           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
15!     CLEAR-SKY COLUMN
16
17!**   INTERFACE.
18!     ----------
19
20!          *SWCLR* IS CALLED EITHER FROM *SW1S*
21!                                OR FROM *SWNI*
22
23!        IMPLICIT ARGUMENTS :
24!        --------------------
25
26!     ==== INPUTS ===
27!     ==== OUTPUTS ===
28
29!     METHOD.
30!     -------
31
32!     EXTERNALS.
33!     ----------
34
35!          NONE
36
37!     REFERENCE.
38!     ----------
39
40!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
41!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
42
43!     AUTHOR.
44!     -------
45!        JEAN-JACQUES MORCRETTE  *ECMWF*
46
47!     MODIFICATIONS.
48!     --------------
49!        ORIGINAL : 94-11-15
50!        Modified : 96-03-19 JJM-PhD (loop 107 in absence of aerosols)
51!        JJMorcrette 990128 : sunshine duration
52!        JJMorcrette 990128 : sunshine duration
53!        99-05-25   JJMorcrette    Revised aerosols
54!        JJMorcrette 001218 : 6 spectral intervals
55!        03-10-10 Deborah Salmond and Marta Janiskova Optimisation
56!        M.Hamrud      01-Oct-2003 CY28 Cleaning
57!        A.Grini (Meteo-France: 2005-11-10)
58!        Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties
59!        Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
60!        O.Boucher fev.2014: modification sur les aerosols pour utiliser les variables DST
61!     ------------------------------------------------------------------
62
63USE PARKIND1  ,ONLY : JPIM     ,JPRB
64USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
65
66USE YOESW    , ONLY : RTAUA    ,RPIZA    ,RCGA
67!USE YOERAD   , ONLY : NOVLP    ,NSW
68! NSW mis dans .def MPL 20140211
69USE YOERAD   , ONLY : NOVLP   
70USE YOERDI   , ONLY : REPCLC
71USE YOERDU   , ONLY : REPSCT
72
73IMPLICIT NONE
74INCLUDE "clesphys.h"
75
76INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
77INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
78INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
79INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
80INTEGER(KIND=JPIM),INTENT(IN)    :: KAER
81INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
82REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
83REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW)
84REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSIG(KLON,KLEV)
85REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAYL(KLON)
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC(KLON)
87!++MODIFCODE
88LOGICAL           ,INTENT(IN)    :: LDDUST                   ! flag for DUST
89REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV)
90REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV)
91REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_DST(KLON,KLEV)
92!--MODIFCODE
93REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCGAZ(KLON,KLEV)
94REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPIZAZ(KLON,KLEV)
95REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAY1(KLON,KLEV+1)
96REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAY2(KLON,KLEV+1)
97REAL(KIND=JPRB)   ,INTENT(OUT)   :: PREFZ(KLON,2,KLEV+1)
98REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRJ(KLON,6,KLEV+1)
99REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRK(KLON,6,KLEV+1)
100REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRMU0(KLON,KLEV+1)
101REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTAUAZ(KLON,KLEV)
102REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRA1(KLON,KLEV+1)
103REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRA2(KLON,KLEV+1)
104REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRCLR(KLON)
105!     ------------------------------------------------------------------
106
107!*       0.1   ARGUMENTS
108!              ---------
109
110!     ------------------------------------------------------------------
111
112!              ------------
113
114REAL(KIND=JPRB) :: ZC0I(KLON,KLEV+1)&
115 & ,  ZCLE0(KLON,KLEV), ZCLEAR(KLON) &
116 & ,  ZR21(KLON)&
117 & ,  ZR23(KLON) , ZSS0(KLON) , ZSCAT(KLON)&
118 & ,  ZTR(KLON,2,KLEV+1) 
119
120INTEGER(KIND=JPIM) :: IKL, JA, JAE, JAJ, JK, JKL, JKLP1, JKM1, JL, INU1
121
122REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZDEN, ZDEN1, ZFACOA,&
123 & ZFF, ZGAP, ZGAR, ZMU1, ZMUE, ZRATIO, ZRE11, &
124 & ZTO, ZTRAY, ZWW, ZDENB   
125REAL(KIND=JPRB) :: ZRR,ZMU0,ZI2MU1,ZIMU1,ZIDEN,ZIDEN1
126REAL(KIND=JPRB) :: ZHOOK_HANDLE
127!++MODIFCODE
128REAL(KIND=JPRB) ::ZFACOA_NEW(KLON,KLEV)
129!--MODIFCODE
130
131
132!     ------------------------------------------------------------------
133
134!*         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
135!                --------------------------------------------
136
137IF (LHOOK) CALL DR_HOOK('SWCLR',0,ZHOOK_HANDLE)
138DO JK = 1 , KLEV+1
139  DO JA = 1 , 6
140    DO JL = KIDIA,KFDIA
141      PRJ(JL,JA,JK) = 0.0_JPRB
142      PRK(JL,JA,JK) = 0.0_JPRB
143    ENDDO
144  ENDDO
145ENDDO
146
147! ------   NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
148
149DO JK = 1 , KLEV
150  IKL=KLEV+1-JK
151  DO JL = KIDIA,KFDIA
152    PCGAZ(JL,JK) = 0.0_JPRB
153    PPIZAZ(JL,JK) =  0.0_JPRB
154    PTAUAZ(JL,JK) = 0.0_JPRB
155    ZFACOA_NEW(JL,JK) = 0.0_JPRB
156  ENDDO
157
158!++MODIFCODE 
159!--OB on fait passer les aerosols LMDZ dans la variable DST
160  IF(NOVLP < 5)THEN !ECMWF VERSION
161!  DO JAE=1,6
162      DO JL = KIDIA,KFDIA
163!        PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL,JAE,IKL)*RTAUA(KNU,JAE)
164        PTAUAZ(JL,JK)=PTAU_DST(JL,IKL)
165!        PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JAE,IKL)&
166!         & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE) 
167        PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)
168!        PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JAE,IKL)&
169!         & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) 
170        PCGAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
171      ENDDO
172!    ENDDO
173  ELSE ! MESONH VERSION
174!--OB on utilise directement les aerosols LMDZ
175!     DO JAE=1,6
176        DO JL = KIDIA,KFDIA
177           !Special optical properties for dust
178!           IF (LDDUST.AND.(JAE==3)) THEN
179           !Ponderation of aerosol optical properties:first step
180           !ti
181!            PTAUAZ(JL,JK)=PTAUAZ(JL,JK) + PAER(JL,JAE,IKL) * PTAUREL_DST(JL,IKL)
182            PTAUAZ(JL,JK)= PTAU_DST(JL,IKL)
183           !wi*ti
184!             PPIZAZ(JL,JK)=PPIZAZ(JL,JK) + PAER(JL,JAE,IKL)  &
185!                   & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)
186             PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)
187           !wi*ti*gi
188!             PCGAZ(JL,JK) = PCGAZ(JL,JK) + PAER(JL,JAE,IKL) &
189!                &  *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
190             PCGAZ(JL,JK) = PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
191           !wi*ti*(gi**2)
192!             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
193!                & *PTAUREL_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
194!                & PCGA_DST(JL,IKL)
195             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+&
196                & PTAU_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
197                & PCGA_DST(JL,IKL)
198!           ELSE
199           !Ponderation of aerosol optical properties:first step
200           !ti
201!             PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE)
202           !wi*ti
203!             PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)&
204!                &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
205           !wi*ti*gi
206!             PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL, JAE, IKL)&
207!                &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
208           !wi*ti*(gi**2)
209!             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
210!                &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)*RCGA(KNU,JAE)
211!           ENDIF
212        ENDDO
213!     ENDDO
214  ENDIF
215!--MODIFCODE 
216
217!++MODIFCODE 
218  IF (NOVLP < 5) then !ECMWF VERSION
219   DO JL = KIDIA,KFDIA
220    IF (KAER /= 0) THEN
221      PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
222      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
223!!!! wrong  ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
224!--     
225      ZGAR = PCGAZ(JL,JK)
226      ZFF = ZGAR * ZGAR
227
228!-- bug-fix: ZRATIO must be defined from the transformed value of optical thickness
229! MPLFH : ZTRAY N'EST PAS INITIALISE !!!!! A REVOIR (MPL)
230      ZTRAY=0.
231!     print *,'>>>>>>> swclr: ZTRAY ',ZTRAY
232      ZDENB = ZTRAY + PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF)
233      ZRATIO=ZTRAY/ZDENB
234 !--     
235      PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF)
236      PCGAZ(JL,JK) = ZGAR * (1.0_JPRB - ZRATIO) / (1.0_JPRB + ZGAR)
237      PPIZAZ(JL,JK) =ZRATIO+(1.0_JPRB-ZRATIO)*PPIZAZ(JL,JK)*(1.0_JPRB-ZFF)&
238       & / (1.0_JPRB - PPIZAZ(JL,JK) * ZFF) 
239    ELSE
240      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
241      PTAUAZ(JL,JK) = ZTRAY
242      PCGAZ(JL,JK) = 0.0_JPRB
243      PPIZAZ(JL,JK) = 1.0_JPRB-REPSCT
244    ENDIF
245  ENDDO
246  ELSE !MESONH VERSION
247   DO JL = KIDIA,KFDIA
248    IF (KAER /= 0) THEN
249      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
250      ZRATIO =PPIZAZ(JL,JK)+ZTRAY
251      !Ponderation G**2
252      ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)/ZRATIO
253      !Ponderation w
254      PPIZAZ(JL,JK)=ZRATIO/(PTAUAZ(JL,JK)+ZTRAY)
255      !Ponderation g
256      PCGAZ(JL,JK)=PCGAZ(JL,JK)/ZRATIO
257      !Ponderation+delta-modified parameters tau
258      PTAUAZ(JL,JK)=(ZTRAY+PTAUAZ(JL,JK))*&
259       &  (1.0_JPRB-PPIZAZ(JL,JK)*ZFACOA_NEW(JL,JK))
260      !delta-modified parameters w
261      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)*(1.0_JPRB-ZFACOA_NEW(JL,JK))/&
262          & (1.0_JPRB-ZFACOA_NEW(JL,JK)*PPIZAZ(JL,JK))     
263      !delta-modified parameters g
264      PCGAZ(JL,JK)=PCGAZ(JL,JK)/(1.0_JPRB+PCGAZ(JL,JK))
265     
266    ELSE
267      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
268      ZFACOA_NEW(JL,JK)= 0.0_JPRB
269      PTAUAZ(JL,JK) = ZTRAY
270      PCGAZ(JL,JK) = 0.0_JPRB
271      PPIZAZ(JL,JK) = 1.0_JPRB-REPSCT
272    ENDIF
273   ENDDO   
274  ENDIF
275!--MODIFCODE 
276 
277ENDDO
278
279!     ------------------------------------------------------------------
280
281!*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
282!                ----------------------------------------------
283
284DO JL = KIDIA,KFDIA
285  ZR23(JL) = 0.0_JPRB
286  ZC0I(JL,KLEV+1) = 0.0_JPRB
287  ZCLEAR(JL) = 1.0_JPRB
288  ZSCAT(JL) = 0.0_JPRB
289ENDDO
290
291JK = 1
292JKL = KLEV+1 - JK
293JKLP1 = JKL + 1
294DO JL = KIDIA,KFDIA
295!++MODIFCODE
296  IF (NOVLP >= 5) THEN
297   ZFACOA = PTAUAZ(JL,JK)
298   ZCORAE = ZFACOA *  PSEC(JL)
299  ELSE
300   ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
301   ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
302  ENDIF
303!--MODIFCODE
304  ZR21(JL) = EXP(-ZCORAE   )
305  ZSS0(JL) = 1.0_JPRB-ZR21(JL)
306  ZCLE0(JL,JKL) = ZSS0(JL)
307
308  IF (NOVLP == 1 .OR. NOVLP == 4) THEN
309!* maximum-random     
310    ZCLEAR(JL) = ZCLEAR(JL)&
311     & *(1.0_JPRB-MAX(ZSS0(JL),ZSCAT(JL)))&
312     & /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC)) 
313    ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL)
314    ZSCAT(JL) = ZSS0(JL)
315  ELSEIF (NOVLP == 2) THEN
316!* maximum
317    ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
318    ZC0I(JL,JKL) = ZSCAT(JL)
319!++MODIFCODE
320  ELSEIF ((NOVLP == 3).OR.(NOVLP  >=  5)) THEN
321!--MODIFCODE
322!* random
323    ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-ZSS0(JL))
324    ZSCAT(JL) = 1.0_JPRB - ZCLEAR(JL)
325    ZC0I(JL,JKL) = ZSCAT(JL)
326  ENDIF
327ENDDO
328
329DO JK = 2 , KLEV
330  JKL = KLEV+1 - JK
331  JKLP1 = JKL + 1
332  DO JL = KIDIA,KFDIA
333!++MODIFCODE
334    IF (NOVLP >= 5) THEN
335     ZFACOA = PTAUAZ(JL,JK)
336     ZCORAE = ZFACOA *  PSEC(JL)
337    ELSE
338    ZFACOA = 1.0_JPRB - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
339    ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
340    ENDIF
341!--MODIFCODE
342    ZR21(JL) = EXP(-ZCORAE   )
343    ZSS0(JL) = 1.0_JPRB-ZR21(JL)
344    ZCLE0(JL,JKL) = ZSS0(JL)
345
346    IF (NOVLP == 1 .OR. NOVLP == 4) THEN
347!* maximum-random     
348      ZCLEAR(JL) = ZCLEAR(JL)&
349       & *(1.0_JPRB-MAX(ZSS0(JL),ZSCAT(JL)))&
350       & /(1.0_JPRB-MIN(ZSCAT(JL),1.0_JPRB-REPCLC)) 
351      ZC0I(JL,JKL) = 1.0_JPRB - ZCLEAR(JL)
352      ZSCAT(JL) = ZSS0(JL)
353    ELSEIF (NOVLP == 2) THEN
354!* maximum
355      ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
356      ZC0I(JL,JKL) = ZSCAT(JL)
357!++MODIFCODE
358    ELSEIF ((NOVLP == 3).OR.(NOVLP >= 5)) THEN
359!--MODIFCODE
360!* random
361      ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-ZSS0(JL))
362      ZSCAT(JL) = 1.0_JPRB - ZCLEAR(JL)
363      ZC0I(JL,JKL) = ZSCAT(JL)
364    ENDIF
365  ENDDO
366ENDDO
367
368!     ------------------------------------------------------------------
369
370!*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
371!                -----------------------------------------------
372
373DO JL = KIDIA,KFDIA
374  PRAY1(JL,KLEV+1) = 0.0_JPRB
375  PRAY2(JL,KLEV+1) = 0.0_JPRB
376  PREFZ(JL,2,1) = PALBP(JL,KNU)
377  PREFZ(JL,1,1) = PALBP(JL,KNU)
378  PTRA1(JL,KLEV+1) = 1.0_JPRB
379  PTRA2(JL,KLEV+1) = 1.0_JPRB
380ENDDO
381
382DO JK = 2 , KLEV+1
383  JKM1 = JK-1
384  DO JL = KIDIA,KFDIA
385
386!     ------------------------------------------------------------------
387
388!*         3.1  EQUIVALENT ZENITH ANGLE
389!               -----------------------
390
391    ZMUE = (1.0_JPRB-ZC0I(JL,JK)) * PSEC(JL)+ ZC0I(JL,JK) * 1.66_JPRB
392    PRMU0(JL,JK) = 1.0_JPRB/ZMUE
393    ZMU0=PRMU0(JL,JK)
394
395!     ------------------------------------------------------------------
396
397!*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
398!               ----------------------------------------------------
399
400    ZGAP = PCGAZ(JL,JKM1)
401    ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP *ZMU0
402    ZWW = PPIZAZ(JL,JKM1)
403    ZTO = PTAUAZ(JL,JKM1)
404    ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
405     & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE 
406    ZIDEN=1.0_JPRB / ZDEN
407    PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN
408    PTRA1(JL,JKM1) = ZIDEN
409
410    ZMU1 = 0.5_JPRB
411    ZIMU1=2.0_JPRB
412    ZI2MU1=4.0_JPRB
413    ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1
414    ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 &
415     & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1 
416    ZIDEN1=1.0_JPRB / ZDEN1
417    PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 *ZIDEN1
418    PTRA2(JL,JKM1) = ZIDEN1
419
420    ZRR=1.0_JPRB/(1.0_JPRB-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))
421    PREFZ(JL,1,JK) = PRAY1(JL,JKM1)&
422     & + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
423     & * PTRA2(JL,JKM1)&
424     & *ZRR 
425
426    ZTR(JL,1,JKM1) = PTRA1(JL,JKM1)&
427     & *ZRR 
428
429    PREFZ(JL,2,JK) = PRAY1(JL,JKM1)&
430     & + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
431     & * PTRA2(JL,JKM1)   
432
433    ZTR(JL,2,JKM1) = PTRA1(JL,JKM1)
434
435  ENDDO
436ENDDO
437DO JL = KIDIA,KFDIA
438  ZMUE = (1.0_JPRB-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66_JPRB
439  PRMU0(JL,1)=1.0_JPRB/ZMUE
440  PTRCLR(JL)=1.0_JPRB-ZC0I(JL,1)
441ENDDO
442
443!     ------------------------------------------------------------------
444
445!*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
446!                 -------------------------------------------------
447
448IF (NSW <= 4) THEN
449  INU1=1
450ELSEIF (NSW == 6) THEN
451  INU1=3
452ENDIF   
453
454IF (KNU <= INU1) THEN
455  JAJ = 2
456  DO JL = KIDIA,KFDIA
457    PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
458    PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
459  ENDDO
460
461  DO JK = 1 , KLEV
462    JKL = KLEV+1 - JK
463    JKLP1 = JKL + 1
464    DO JL = KIDIA,KFDIA
465      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
466      PRJ(JL,JAJ,JKL) = ZRE11
467      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,  1,JKL)
468    ENDDO
469  ENDDO
470
471ELSE
472
473  DO JAJ = 1 , 2
474    DO JL = KIDIA,KFDIA
475      PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
476      PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
477    ENDDO
478
479    DO JK = 1 , KLEV
480      JKL = KLEV+1 - JK
481      JKLP1 = JKL + 1
482      DO JL = KIDIA,KFDIA
483        ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
484        PRJ(JL,JAJ,JKL) = ZRE11
485        PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
486      ENDDO
487    ENDDO
488  ENDDO
489
490ENDIF
491
492!     ------------------------------------------------------------------
493
494IF (LHOOK) CALL DR_HOOK('SWCLR',1,ZHOOK_HANDLE)
495END SUBROUTINE SWCLR
Note: See TracBrowser for help on using the repository browser.