source: LMDZ6/trunk/libf/phylmd/rrtm/swr.F90 @ 5456

Last change on this file since 5456 was 5294, checked in by Laurent Fairhead, 2 months ago

Keeping clesphys.h was not the right solution
LF
  • 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: 14.4 KB
RevLine 
[1989]1SUBROUTINE SWR &
2 & ( KIDIA , KFDIA , KLON , KLEV  , KNU,&
3 & PALBD , PCG   , PCLD , POMEGA, PSEC , PTAU,&
4 & PCGAZ , PPIZAZ, PRAY1, PRAY2 , PREFZ, PRJ  , PRK , PRMUE,&
5 & PTAUAZ, PTRA1 , PTRA2, PTRCLD &
6 & ) 
7
8!**** *SWR* - CONTINUUM SCATTERING COMPUTATIONS
9
10!     PURPOSE.
11!     --------
12!           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
13!     CONTINUUM SCATTERING
14
15!**   INTERFACE.
16!     ----------
17
18!          *SWR* IS CALLED EITHER FROM *SW1S*
19!                              OR FROM *SWNI*
20
21!        IMPLICIT ARGUMENTS :
22!        --------------------
23
24!     ==== INPUTS ===
25!     ==== OUTPUTS ===
26
27!     METHOD.
28!     -------
29
30!          1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
31!     OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)
32
33!     EXTERNALS.
34!     ----------
35
36!          *SWDE*
37
38!     REFERENCE.
39!     ----------
40
41!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
42!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
43
44!     AUTHOR.
45!     -------
46!        JEAN-JACQUES MORCRETTE  *ECMWF*
47
48!     MODIFICATIONS.
49!     --------------
50!        ORIGINAL : 89-07-14
51!        Ph. DANDIN Meteo-France 05-96 : Effect of cloud layer
52!        JJMorcrette 990128 : sunshine duration
53!        JJMorcrette 001218 : 6 spectral intervals
54!        03-10-10 Deborah Salmond and Marta Janiskova Optimisation
55!        M.Hamrud      01-Oct-2003 CY28 Cleaning
56!        Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
57!     ------------------------------------------------------------------
58
59USE PARKIND1  ,ONLY : JPIM     ,JPRB
60USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
61
62!USE YOERAD   , ONLY : NOVLP    ,NSW
63! NSW mis dans ;def MPL 20140211
64USE YOERAD   , ONLY : NOVLP   
65USE YOECLD   , ONLY : REPSEC
66USE YOEOVLP  , ONLY : RA1OVLP
67USE write_field_phy
[5294]68! Temporary fix waiting for cleaner interface (or not)
69USE clesphys_mod_h, ONLY: NSW
[1989]70
71IMPLICIT NONE
72
[5294]73!!include "clesphys.h"
[1989]74INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
75INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
76INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
77INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
78INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
79REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
80REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG(KLON,NSW,KLEV)
81REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLD(KLON,KLEV)
82REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA(KLON,NSW,KLEV)
83REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC(KLON)
84REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU(KLON,NSW,KLEV)
85REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGAZ(KLON,KLEV)
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZAZ(KLON,KLEV)
87REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAY1(KLON,KLEV+1)
88REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAY2(KLON,KLEV+1)
89REAL(KIND=JPRB)   ,INTENT(OUT)   :: PREFZ(KLON,2,KLEV+1)
90REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRJ(KLON,6,KLEV+1)
91REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRK(KLON,6,KLEV+1)
92REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRMUE(KLON,KLEV+1)
93REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAZ(KLON,KLEV)
94REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRA1(KLON,KLEV+1)
95REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRA2(KLON,KLEV+1)
96REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRCLD(KLON)
97!     ------------------------------------------------------------------
98
99!*       0.1   ARGUMENTS
100!              ---------
101
102!     ------------------------------------------------------------------
103
104!              ------------
105
106REAL(KIND=JPRB) :: ZC1I(KLON,KLEV+1)    , ZCLEQ(KLON,KLEV)&
107 & ,  ZCLEAR(KLON)         , ZCLOUD(KLON) &
108 & ,  ZGG(KLON)            , ZREF(KLON)&
109 & ,  ZRE1(KLON)           , ZRE2(KLON)&
110 & ,  ZRMUZ(KLON)          , ZRNEB(KLON)&
111 & ,  ZR21(KLON)           , ZR22(KLON)&
112 & ,  ZR23(KLON)           , ZSS1(KLON)&
113 & ,  ZTO1(KLON)           , ZTR(KLON,2,KLEV+1)&
114 & ,  ZTR1(KLON)           , ZTR2(KLON)&
115 & ,  ZW(KLON) 
116
117INTEGER(KIND=JPIM) :: IKL, IKLP1, JA, JAJ, JK, JKM1, JL, INU1
118
119REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZCORCD, ZDEN, ZDEN1,&
120 & ZFACOA, ZFACOC, ZGAP, ZMU1, ZMUE, ZRE11, &
121 & ZTO, ZWW, ZALPHA1, ZCHKAE, ZCHKCD 
122REAL(KIND=JPRB) :: ZRR,ZIMU1,ZI2MU1,ZIDEN,ZIDEN1
123REAL(KIND=JPRB) :: ZHOOK_HANDLE
124LOGICAL         :: LLDEBUG
125
126#include "swde.intfb.h"
127
128!     ------------------------------------------------------------------
129
130!*         1.    INITIALIZATION
131!                --------------
132
133IF (LHOOK) CALL DR_HOOK('SWR',0,ZHOOK_HANDLE)
134LLDEBUG=.FALSE.
135DO JK = 1 , KLEV+1
136  DO JA = 1 , 6
137    DO JL = KIDIA,KFDIA
138      PRJ(JL,JA,JK) = 0.0_JPRB
139      PRK(JL,JA,JK) = 0.0_JPRB
140    ENDDO
141  ENDDO
142ENDDO
143
144REPSEC=1.E-12_JPRB    !!!!! A REVOIR (MPL) 220109
145
146!     ------------------------------------------------------------------
147
148!*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
149!                ----------------------------------------------
150
151DO JL = KIDIA,KFDIA
152  ZR23(JL) = 0.0_JPRB
153  ZC1I(JL,KLEV+1) = 0.0_JPRB
154  ZCLEAR(JL) = 1.0_JPRB
155  ZCLOUD(JL) = 0.0_JPRB
156ENDDO
157
158JK = 1
159IKL = KLEV+1 - JK
160IKLP1 = IKL + 1
161ZALPHA1=RA1OVLP( IKL )
162DO JL = KIDIA,KFDIA
163!++MODIFCODE
164  IF (NOVLP >= 5) THEN !MESONH VERSION
[2010]165   stop 'provisoire pour verifier option novlp=1'
[1989]166   ZFACOA =PTAUAZ(JL,IKL)
167   ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
168   ZCORAE = ZFACOA * PSEC(JL)
169   ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
170  ELSE !ECMWF VERSION
171ZFACOA = 1.0_JPRB - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
172  ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
173  ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
174  ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
175  ENDIF
176!--MODIFCODE
177  ZCHKAE = MIN( 200._JPRB, ZCORAE )
178  ZCHKCD = MIN( 200._JPRB, ZCORCD )
179  ZR21(JL) = EXP( - ZCHKAE )
180  ZR22(JL) = EXP( - ZCHKCD )
181 
182  ZSS1(JL) = PCLD(JL,IKL)*(1.0_JPRB-ZR21(JL)*ZR22(JL))&
183   & + (1.0_JPRB-PCLD(JL,IKL))*(1.0_JPRB-ZR21(JL)) 
184  ZCLEQ(JL,IKL) = ZSS1(JL)
185
186!++MODIFCODE
187  IF ((NOVLP == 1).OR.(NOVLP == 8)) THEN
188!--MODIFCODE
189!* maximum-random     
190    ZCLEAR(JL) = ZCLEAR(JL)&
191     & *(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL)))&
192     & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) 
193    ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
194    ZCLOUD(JL) = ZSS1(JL)
195  ELSEIF (NOVLP == 2) THEN
[2596]196!IM150716  stop 'provisoire pour verifier option novlp=1b'
197   print*,'rrtm provisoire pour verifier option novlp=2 maximum'
[1989]198!* maximum
199    ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
200    ZC1I(JL,IKL) = ZCLOUD(JL)
201!++MODIFCODE
202  ELSEIF ((NOVLP == 3).OR.((NOVLP  >=  5).AND.(NOVLP /= 8))) THEN
[2596]203!IM150716  stop 'provisoire pour verifier option novlp=1c'
204    print*,'rrtm provisoire pour verifier option novlp=3 random'
[1989]205!--MODIFCODE
206!* random
207    ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - ZSS1(JL))
208    ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
209    ZC1I(JL,IKL) = ZCLOUD(JL)
210  ELSEIF (NOVLP == 4) THEN
[2010]211   stop 'provisoire pour verifier option novlp=1d'
[1989]212!* Hogan & Illingworth, 2001 
213    ZCLEAR(JL)=ZCLEAR(JL)*( &
214     & ZALPHA1*(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL))) &
215     & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
216     & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-ZSS1(JL)) ) 
217    ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
218    ZCLOUD(JL) = ZSS1(JL)
219  ENDIF
220ENDDO
221
222DO JK = 2 , KLEV
223  IKL = KLEV+1 - JK
224  IKLP1 = IKL + 1
225  ZALPHA1=RA1OVLP( IKL )
226  DO JL = KIDIA,KFDIA
227!++MODIFCODE
228    IF (NOVLP >= 5) THEN !MESONH VERSION
229     ZFACOA =PTAUAZ(JL,IKL)
230     ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
231     ZCORAE = ZFACOA * PSEC(JL)
232     ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
233    ELSE !ECMWF VERSION
234    ZFACOA = 1.0_JPRB - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
235    ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
236    ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
237    ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
238    ENDIF
239!--MODIFCODE
240!    ZR21(JL) = EXP(-ZCORAE   )
241!    ZR22(JL) = EXP(-ZCORCD   )
242
243    ZCHKAE = MIN( 200._JPRB, ZCORAE )
244    ZCHKCD = MIN( 200._JPRB, ZCORCD )
245    ZR21(JL) = EXP( - ZCHKAE )
246    ZR22(JL) = EXP( - ZCHKCD )
247
248    ZSS1(JL) = PCLD(JL,IKL)*(1.0_JPRB-ZR21(JL)*ZR22(JL))&
249     & + (1.0_JPRB-PCLD(JL,IKL))*(1.0_JPRB-ZR21(JL)) 
250    ZCLEQ(JL,IKL) = ZSS1(JL)
251
252!++MODIFCODE
253    IF ((NOVLP == 1).OR.(NOVLP == 8)) THEN
254!--MODIFCODE
255!* maximum-random     
256      ZCLEAR(JL) = ZCLEAR(JL)&
257       & *(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL)))&
258       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) 
259      ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
260      ZCLOUD(JL) = ZSS1(JL)
261    ELSEIF (NOVLP == 2) THEN
262!* maximum
263      ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
264      ZC1I(JL,IKL) = ZCLOUD(JL)
265!++MODIFCODE
266  ELSEIF ((NOVLP == 3).OR.((NOVLP  >=  5).AND.(NOVLP /= 8))) THEN
267!--MODIFCODE
268!* random
269      ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - ZSS1(JL))
270      ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
271      ZC1I(JL,IKL) = ZCLOUD(JL)
272    ELSEIF (NOVLP == 4) THEN
273!* Hogan & Illingworth, 2001 
274      ZCLEAR(JL)=ZCLEAR(JL)*( &
275       & ZALPHA1*(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL))) &
276       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
277       & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-ZSS1(JL)) ) 
278      ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
279      ZCLOUD(JL) = ZSS1(JL)
280    ENDIF
281  ENDDO
282ENDDO
283
284!     ------------------------------------------------------------------
285
286!*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
287!                -----------------------------------------------
288
289DO JL = KIDIA,KFDIA
290  PRAY1(JL,KLEV+1) = 0.0_JPRB
291  PRAY2(JL,KLEV+1) = 0.0_JPRB
292  PREFZ(JL,2,1) = PALBD(JL,KNU)
293  PREFZ(JL,1,1) = PALBD(JL,KNU)
294  PTRA1(JL,KLEV+1) = 1.0_JPRB
295  PTRA2(JL,KLEV+1) = 1.0_JPRB
296ENDDO
297
298DO JK = 2 , KLEV+1
299  JKM1 = JK-1
300  DO JL = KIDIA,KFDIA
301    ZRNEB(JL)= PCLD(JL,JKM1)
302    ZRE1(JL)=0.0_JPRB
303    ZTR1(JL)=0.0_JPRB
304    ZRE2(JL)=0.0_JPRB
305    ZTR2(JL)=0.0_JPRB
306
307!     ------------------------------------------------------------------
308
309!*         3.1  EQUIVALENT ZENITH ANGLE
310!               -----------------------
311
312    ZMUE = (1.0_JPRB-ZC1I(JL,JK)) * PSEC(JL)+ ZC1I(JL,JK) * 1.66_JPRB
313    PRMUE(JL,JK) = 1.0_JPRB/ZMUE
314
315!     ------------------------------------------------------------------
316
317!*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
318!               ----------------------------------------------------
319
320    ZGAP = PCGAZ(JL,JKM1)
321    ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP / ZMUE
322    ZWW = PPIZAZ(JL,JKM1)
323    ZTO = PTAUAZ(JL,JKM1)
324    ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
325     & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE 
326    ZIDEN=1.0_JPRB/ZDEN
327    PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN
328    PTRA1(JL,JKM1) = ZIDEN
329
330    ZMU1 = 0.5_JPRB
331    ZIMU1=2.0_JPRB
332    ZI2MU1=4.0_JPRB
333    ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1
334    ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 &
335     & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1 
336    ZIDEN1=1.0_JPRB/ZDEN1
337    PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 * ZIDEN1
338    PTRA2(JL,JKM1) = ZIDEN1
339
340!     ------------------------------------------------------------------
341
342!*         3.3  EFFECT OF CLOUD LAYER
343!               ---------------------
344
345
346!++MODIFCODE
347    IF (NOVLP >= 5)THEN !MESONH VERSION
348     ZW(JL) =PCG(JL,KNU,JKM1)*PCG(JL,KNU,JKM1)
349     ZTO1(JL) = PTAU(JL,KNU,JKM1)*(1-(POMEGA(JL,KNU,JKM1)*ZW(JL)))
350     ZW(JL) =POMEGA(JL,KNU,JKM1)*(1-ZW(JL))/(1-(POMEGA(JL,KNU,JKM1)*ZW(JL)))
351     ZGG(JL) = PCG(JL,KNU,JKM1)/(1+PCG(JL,KNU,JKM1))
352     ZGG(JL)=ZTO1(JL)*ZW(JL)*ZGG(JL)+PTAUAZ(JL,JKM1)*PPIZAZ(JL,JKM1)*PCGAZ(JL,JKM1)
353     ZW(JL) =ZTO1(JL)*ZW(JL)+PTAUAZ(JL,JKM1)*PPIZAZ(JL,JKM1)
354     ZTO1(JL) = ZTO1(JL) +  PTAUAZ(JL,JKM1)
355     ZGG(JL)=ZGG(JL)/ZW(JL)
356     ZW(JL) =ZW(JL)/ZTO1(JL)
357    ELSE !ECMWF VERSION
358    ZW(JL) = POMEGA(JL,KNU,JKM1)
359    ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL)+ PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1)
360    ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1)
361    ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
362    ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)&
363     & + (1.0_JPRB - ZR22(JL)) * PCGAZ(JL,JKM1) 
364    IF (ZW(JL) == 1.0_JPRB .AND. PPIZAZ(JL,JKM1) == 1.0_JPRB) THEN
365      ZW(JL)=1.0_JPRB
366    ELSE
367      ZW(JL) = ZR21(JL) / ZTO1(JL)
368     ENDIF
369    ENDIF
370!--MODIFCODE
371    ZREF(JL) = PREFZ(JL,1,JKM1)
372    ZRMUZ(JL) = PRMUE(JL,JK)
373    ENDDO
374
375  CALL SWDE ( KIDIA, KFDIA , KLON,&
376   & ZGG  , ZREF  , ZRMUZ , ZTO1 , ZW,&
377   & ZRE1 , ZRE2  , ZTR1  , ZTR2      ) 
378
379   DO JL = KIDIA,KFDIA
380
381    ZRR=1.0_JPRB/(1.0_JPRB-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))
382
383    PREFZ(JL,1,JK) = (1.0_JPRB-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
384     & + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
385     & * PTRA2(JL,JKM1)&
386     & * ZRR ) &
387     & + ZRNEB(JL) * ZRE2(JL) 
388
389    ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1)&
390     & * ZRR ) &
391     & * (1.0_JPRB-ZRNEB(JL)) 
392
393    PREFZ(JL,2,JK) = (1.0_JPRB-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
394     & + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
395     & * PTRA2(JL,JKM1) )&
396     & + ZRNEB(JL) * ZRE1(JL) 
397
398    ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)+ PTRA1(JL,JKM1) * (1.0_JPRB-ZRNEB(JL))
399
400  ENDDO
401ENDDO
402DO JL = KIDIA,KFDIA
403  ZMUE = (1.0_JPRB-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66_JPRB
404  PRMUE(JL,1)=1.0_JPRB/ZMUE
405  PTRCLD(JL)=1.0_JPRB-ZC1I(JL,1)
406ENDDO
407
408!     ------------------------------------------------------------------
409
410!*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
411!                 -------------------------------------------------
412
413IF (NSW <= 4) THEN
414  INU1=1
415ELSEIF (NSW == 6) THEN
416  INU1=3
417ENDIF   
418
419IF (KNU <= INU1) THEN
420  JAJ = 2
421  DO JL = KIDIA,KFDIA
422    PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
423    PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
424  ENDDO
425
426  DO JK = 1 , KLEV
427    IKL = KLEV+1 - JK
428    IKLP1 = IKL + 1
429    DO JL = KIDIA,KFDIA
430      ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,  1,IKL)
431      PRJ(JL,JAJ,IKL) = ZRE11
432      PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,  1,IKL)
433    ENDDO
434  ENDDO
435
436ELSE
437
438  DO JAJ = 1 , 2
439    DO JL = KIDIA,KFDIA
440      PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
441      PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
442    ENDDO
443
444    DO JK = 1 , KLEV
445      IKL = KLEV+1 - JK
446      IKLP1 = IKL + 1
447      DO JL = KIDIA,KFDIA
448        ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,JAJ,IKL)
449        PRJ(JL,JAJ,IKL) = ZRE11
450        PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,JAJ,IKL)
451      ENDDO
452    ENDDO
453  ENDDO
454
455ENDIF
456IF(LLDEBUG) THEN
457 call writefield_phy ('swr_zc1i',ZC1I,KLEV+1)
458 call writefield_phy ('swr_zss1',ZSS1,1)
459 call writefield_phy ('swr_zclear',ZCLEAR,1)
460 call writefield_phy ('swr_prmue',PRMUE,KLEV+1)
461 call writefield_phy ('swr_psec',PSEC,1)
462 call writefield_phy ('swr_prmue',PRMUE,KLEV+1)
463 call writefield_phy ('swr_ppizaz',PPIZAZ,KLEV)
464 call writefield_phy ('swr_pcgaz',PCGAZ,KLEV)
465 call writefield_phy ('swr_pcg',PCG,KLEV)
466 call writefield_phy ('swr_ptau',PTAU(:,1,:),KLEV)
467 call writefield_phy ('swr_ptauaz',PTAUAZ,KLEV)
468 call writefield_phy ('swr_pcld',PCLD,KLEV)
469ENDIF
470!     ------------------------------------------------------------------
471
472IF (LHOOK) CALL DR_HOOK('SWR',1,ZHOOK_HANDLE)
473END SUBROUTINE SWR
Note: See TracBrowser for help on using the repository browser.