source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/swclr.F90

Last change on this file was 3331, checked in by acozic, 7 years ago

Add modification for isotopes

  • Property svn:executable set to *
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= PRAYL(JL) * PDSIG(JL,JK)
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.