source: LMDZ5/trunk/libf/phylmd/rrtm/swr.F90 @ 3405

Last change on this file since 3405 was 2596, checked in by musat, 8 years ago

In newmicro allow use of cloud overlap hypothesis defined
in radopt.h as for the radiation code.
In rrtm allow max and random cloud overlap hypothesis.
IM
  • 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.3 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
68
69IMPLICIT NONE
70
71include "clesphys.h"
72INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
73INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
74INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
75INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
76INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
77REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
78REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG(KLON,NSW,KLEV)
79REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLD(KLON,KLEV)
80REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA(KLON,NSW,KLEV)
81REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC(KLON)
82REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU(KLON,NSW,KLEV)
83REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGAZ(KLON,KLEV)
84REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZAZ(KLON,KLEV)
85REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAY1(KLON,KLEV+1)
86REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRAY2(KLON,KLEV+1)
87REAL(KIND=JPRB)   ,INTENT(OUT)   :: PREFZ(KLON,2,KLEV+1)
88REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRJ(KLON,6,KLEV+1)
89REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRK(KLON,6,KLEV+1)
90REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRMUE(KLON,KLEV+1)
91REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAZ(KLON,KLEV)
92REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRA1(KLON,KLEV+1)
93REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRA2(KLON,KLEV+1)
94REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRCLD(KLON)
95!     ------------------------------------------------------------------
96
97!*       0.1   ARGUMENTS
98!              ---------
99
100!     ------------------------------------------------------------------
101
102!              ------------
103
104REAL(KIND=JPRB) :: ZC1I(KLON,KLEV+1)    , ZCLEQ(KLON,KLEV)&
105 & ,  ZCLEAR(KLON)         , ZCLOUD(KLON) &
106 & ,  ZGG(KLON)            , ZREF(KLON)&
107 & ,  ZRE1(KLON)           , ZRE2(KLON)&
108 & ,  ZRMUZ(KLON)          , ZRNEB(KLON)&
109 & ,  ZR21(KLON)           , ZR22(KLON)&
110 & ,  ZR23(KLON)           , ZSS1(KLON)&
111 & ,  ZTO1(KLON)           , ZTR(KLON,2,KLEV+1)&
112 & ,  ZTR1(KLON)           , ZTR2(KLON)&
113 & ,  ZW(KLON) 
114
115INTEGER(KIND=JPIM) :: IKL, IKLP1, JA, JAJ, JK, JKM1, JL, INU1
116
117REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZCORCD, ZDEN, ZDEN1,&
118 & ZFACOA, ZFACOC, ZGAP, ZMU1, ZMUE, ZRE11, &
119 & ZTO, ZWW, ZALPHA1, ZCHKAE, ZCHKCD 
120REAL(KIND=JPRB) :: ZRR,ZIMU1,ZI2MU1,ZIDEN,ZIDEN1
121REAL(KIND=JPRB) :: ZHOOK_HANDLE
122LOGICAL         :: LLDEBUG
123
124#include "swde.intfb.h"
125
126!     ------------------------------------------------------------------
127
128!*         1.    INITIALIZATION
129!                --------------
130
131IF (LHOOK) CALL DR_HOOK('SWR',0,ZHOOK_HANDLE)
132LLDEBUG=.FALSE.
133DO JK = 1 , KLEV+1
134  DO JA = 1 , 6
135    DO JL = KIDIA,KFDIA
136      PRJ(JL,JA,JK) = 0.0_JPRB
137      PRK(JL,JA,JK) = 0.0_JPRB
138    ENDDO
139  ENDDO
140ENDDO
141
142REPSEC=1.E-12_JPRB    !!!!! A REVOIR (MPL) 220109
143
144!     ------------------------------------------------------------------
145
146!*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
147!                ----------------------------------------------
148
149DO JL = KIDIA,KFDIA
150  ZR23(JL) = 0.0_JPRB
151  ZC1I(JL,KLEV+1) = 0.0_JPRB
152  ZCLEAR(JL) = 1.0_JPRB
153  ZCLOUD(JL) = 0.0_JPRB
154ENDDO
155
156JK = 1
157IKL = KLEV+1 - JK
158IKLP1 = IKL + 1
159ZALPHA1=RA1OVLP( IKL )
160DO JL = KIDIA,KFDIA
161!++MODIFCODE
162  IF (NOVLP >= 5) THEN !MESONH VERSION
[2010]163   stop 'provisoire pour verifier option novlp=1'
[1989]164   ZFACOA =PTAUAZ(JL,IKL)
165   ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
166   ZCORAE = ZFACOA * PSEC(JL)
167   ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
168  ELSE !ECMWF VERSION
169ZFACOA = 1.0_JPRB - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
170  ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
171  ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
172  ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
173  ENDIF
174!--MODIFCODE
175  ZCHKAE = MIN( 200._JPRB, ZCORAE )
176  ZCHKCD = MIN( 200._JPRB, ZCORCD )
177  ZR21(JL) = EXP( - ZCHKAE )
178  ZR22(JL) = EXP( - ZCHKCD )
179 
180  ZSS1(JL) = PCLD(JL,IKL)*(1.0_JPRB-ZR21(JL)*ZR22(JL))&
181   & + (1.0_JPRB-PCLD(JL,IKL))*(1.0_JPRB-ZR21(JL)) 
182  ZCLEQ(JL,IKL) = ZSS1(JL)
183
184!++MODIFCODE
185  IF ((NOVLP == 1).OR.(NOVLP == 8)) THEN
186!--MODIFCODE
187!* maximum-random     
188    ZCLEAR(JL) = ZCLEAR(JL)&
189     & *(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL)))&
190     & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) 
191    ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
192    ZCLOUD(JL) = ZSS1(JL)
193  ELSEIF (NOVLP == 2) THEN
[2596]194!IM150716  stop 'provisoire pour verifier option novlp=1b'
195   print*,'rrtm provisoire pour verifier option novlp=2 maximum'
[1989]196!* maximum
197    ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
198    ZC1I(JL,IKL) = ZCLOUD(JL)
199!++MODIFCODE
200  ELSEIF ((NOVLP == 3).OR.((NOVLP  >=  5).AND.(NOVLP /= 8))) THEN
[2596]201!IM150716  stop 'provisoire pour verifier option novlp=1c'
202    print*,'rrtm provisoire pour verifier option novlp=3 random'
[1989]203!--MODIFCODE
204!* random
205    ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - ZSS1(JL))
206    ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
207    ZC1I(JL,IKL) = ZCLOUD(JL)
208  ELSEIF (NOVLP == 4) THEN
[2010]209   stop 'provisoire pour verifier option novlp=1d'
[1989]210!* Hogan & Illingworth, 2001 
211    ZCLEAR(JL)=ZCLEAR(JL)*( &
212     & ZALPHA1*(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL))) &
213     & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
214     & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-ZSS1(JL)) ) 
215    ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
216    ZCLOUD(JL) = ZSS1(JL)
217  ENDIF
218ENDDO
219
220DO JK = 2 , KLEV
221  IKL = KLEV+1 - JK
222  IKLP1 = IKL + 1
223  ZALPHA1=RA1OVLP( IKL )
224  DO JL = KIDIA,KFDIA
225!++MODIFCODE
226    IF (NOVLP >= 5) THEN !MESONH VERSION
227     ZFACOA =PTAUAZ(JL,IKL)
228     ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
229     ZCORAE = ZFACOA * PSEC(JL)
230     ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
231    ELSE !ECMWF VERSION
232    ZFACOA = 1.0_JPRB - PPIZAZ(JL,IKL)*PCGAZ(JL,IKL)*PCGAZ(JL,IKL)
233    ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
234    ZCORAE = ZFACOA * PTAUAZ(JL,IKL) * PSEC(JL)
235    ZCORCD = ZFACOC * PTAU(JL,KNU,IKL) * PSEC(JL)
236    ENDIF
237!--MODIFCODE
238!    ZR21(JL) = EXP(-ZCORAE   )
239!    ZR22(JL) = EXP(-ZCORCD   )
240
241    ZCHKAE = MIN( 200._JPRB, ZCORAE )
242    ZCHKCD = MIN( 200._JPRB, ZCORCD )
243    ZR21(JL) = EXP( - ZCHKAE )
244    ZR22(JL) = EXP( - ZCHKCD )
245
246    ZSS1(JL) = PCLD(JL,IKL)*(1.0_JPRB-ZR21(JL)*ZR22(JL))&
247     & + (1.0_JPRB-PCLD(JL,IKL))*(1.0_JPRB-ZR21(JL)) 
248    ZCLEQ(JL,IKL) = ZSS1(JL)
249
250!++MODIFCODE
251    IF ((NOVLP == 1).OR.(NOVLP == 8)) THEN
252!--MODIFCODE
253!* maximum-random     
254      ZCLEAR(JL) = ZCLEAR(JL)&
255       & *(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL)))&
256       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) 
257      ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
258      ZCLOUD(JL) = ZSS1(JL)
259    ELSEIF (NOVLP == 2) THEN
260!* maximum
261      ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
262      ZC1I(JL,IKL) = ZCLOUD(JL)
263!++MODIFCODE
264  ELSEIF ((NOVLP == 3).OR.((NOVLP  >=  5).AND.(NOVLP /= 8))) THEN
265!--MODIFCODE
266!* random
267      ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - ZSS1(JL))
268      ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
269      ZC1I(JL,IKL) = ZCLOUD(JL)
270    ELSEIF (NOVLP == 4) THEN
271!* Hogan & Illingworth, 2001 
272      ZCLEAR(JL)=ZCLEAR(JL)*( &
273       & ZALPHA1*(1.0_JPRB-MAX(ZSS1(JL),ZCLOUD(JL))) &
274       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
275       & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-ZSS1(JL)) ) 
276      ZC1I(JL,IKL) = 1.0_JPRB - ZCLEAR(JL)
277      ZCLOUD(JL) = ZSS1(JL)
278    ENDIF
279  ENDDO
280ENDDO
281
282!     ------------------------------------------------------------------
283
284!*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
285!                -----------------------------------------------
286
287DO JL = KIDIA,KFDIA
288  PRAY1(JL,KLEV+1) = 0.0_JPRB
289  PRAY2(JL,KLEV+1) = 0.0_JPRB
290  PREFZ(JL,2,1) = PALBD(JL,KNU)
291  PREFZ(JL,1,1) = PALBD(JL,KNU)
292  PTRA1(JL,KLEV+1) = 1.0_JPRB
293  PTRA2(JL,KLEV+1) = 1.0_JPRB
294ENDDO
295
296DO JK = 2 , KLEV+1
297  JKM1 = JK-1
298  DO JL = KIDIA,KFDIA
299    ZRNEB(JL)= PCLD(JL,JKM1)
300    ZRE1(JL)=0.0_JPRB
301    ZTR1(JL)=0.0_JPRB
302    ZRE2(JL)=0.0_JPRB
303    ZTR2(JL)=0.0_JPRB
304
305!     ------------------------------------------------------------------
306
307!*         3.1  EQUIVALENT ZENITH ANGLE
308!               -----------------------
309
310    ZMUE = (1.0_JPRB-ZC1I(JL,JK)) * PSEC(JL)+ ZC1I(JL,JK) * 1.66_JPRB
311    PRMUE(JL,JK) = 1.0_JPRB/ZMUE
312
313!     ------------------------------------------------------------------
314
315!*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
316!               ----------------------------------------------------
317
318    ZGAP = PCGAZ(JL,JKM1)
319    ZBMU0 = 0.5_JPRB - 0.75_JPRB * ZGAP / ZMUE
320    ZWW = PPIZAZ(JL,JKM1)
321    ZTO = PTAUAZ(JL,JKM1)
322    ZDEN = 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
323     & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE 
324    ZIDEN=1.0_JPRB/ZDEN
325    PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE * ZIDEN
326    PTRA1(JL,JKM1) = ZIDEN
327
328    ZMU1 = 0.5_JPRB
329    ZIMU1=2.0_JPRB
330    ZI2MU1=4.0_JPRB
331    ZBMU1 = 0.5_JPRB - 0.75_JPRB * ZGAP * ZMU1
332    ZDEN1= 1.0_JPRB + (1.0_JPRB - ZWW + ZBMU1 * ZWW) * ZTO * ZIMU1 &
333     & + (1-ZWW) * (1.0_JPRB - ZWW +2.0_JPRB*ZBMU1*ZWW)*ZTO*ZTO*ZI2MU1 
334    ZIDEN1=1.0_JPRB/ZDEN1
335    PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO * ZIMU1 * ZIDEN1
336    PTRA2(JL,JKM1) = ZIDEN1
337
338!     ------------------------------------------------------------------
339
340!*         3.3  EFFECT OF CLOUD LAYER
341!               ---------------------
342
343
344!++MODIFCODE
345    IF (NOVLP >= 5)THEN !MESONH VERSION
346     ZW(JL) =PCG(JL,KNU,JKM1)*PCG(JL,KNU,JKM1)
347     ZTO1(JL) = PTAU(JL,KNU,JKM1)*(1-(POMEGA(JL,KNU,JKM1)*ZW(JL)))
348     ZW(JL) =POMEGA(JL,KNU,JKM1)*(1-ZW(JL))/(1-(POMEGA(JL,KNU,JKM1)*ZW(JL)))
349     ZGG(JL) = PCG(JL,KNU,JKM1)/(1+PCG(JL,KNU,JKM1))
350     ZGG(JL)=ZTO1(JL)*ZW(JL)*ZGG(JL)+PTAUAZ(JL,JKM1)*PPIZAZ(JL,JKM1)*PCGAZ(JL,JKM1)
351     ZW(JL) =ZTO1(JL)*ZW(JL)+PTAUAZ(JL,JKM1)*PPIZAZ(JL,JKM1)
352     ZTO1(JL) = ZTO1(JL) +  PTAUAZ(JL,JKM1)
353     ZGG(JL)=ZGG(JL)/ZW(JL)
354     ZW(JL) =ZW(JL)/ZTO1(JL)
355    ELSE !ECMWF VERSION
356    ZW(JL) = POMEGA(JL,KNU,JKM1)
357    ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL)+ PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1)
358    ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1)
359    ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
360    ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)&
361     & + (1.0_JPRB - ZR22(JL)) * PCGAZ(JL,JKM1) 
362    IF (ZW(JL) == 1.0_JPRB .AND. PPIZAZ(JL,JKM1) == 1.0_JPRB) THEN
363      ZW(JL)=1.0_JPRB
364    ELSE
365      ZW(JL) = ZR21(JL) / ZTO1(JL)
366     ENDIF
367    ENDIF
368!--MODIFCODE
369    ZREF(JL) = PREFZ(JL,1,JKM1)
370    ZRMUZ(JL) = PRMUE(JL,JK)
371    ENDDO
372
373  CALL SWDE ( KIDIA, KFDIA , KLON,&
374   & ZGG  , ZREF  , ZRMUZ , ZTO1 , ZW,&
375   & ZRE1 , ZRE2  , ZTR1  , ZTR2      ) 
376
377   DO JL = KIDIA,KFDIA
378
379    ZRR=1.0_JPRB/(1.0_JPRB-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1))
380
381    PREFZ(JL,1,JK) = (1.0_JPRB-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
382     & + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
383     & * PTRA2(JL,JKM1)&
384     & * ZRR ) &
385     & + ZRNEB(JL) * ZRE2(JL) 
386
387    ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1)&
388     & * ZRR ) &
389     & * (1.0_JPRB-ZRNEB(JL)) 
390
391    PREFZ(JL,2,JK) = (1.0_JPRB-ZRNEB(JL)) * (PRAY1(JL,JKM1)&
392     & + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
393     & * PTRA2(JL,JKM1) )&
394     & + ZRNEB(JL) * ZRE1(JL) 
395
396    ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)+ PTRA1(JL,JKM1) * (1.0_JPRB-ZRNEB(JL))
397
398  ENDDO
399ENDDO
400DO JL = KIDIA,KFDIA
401  ZMUE = (1.0_JPRB-ZC1I(JL,1))*PSEC(JL)+ZC1I(JL,1)*1.66_JPRB
402  PRMUE(JL,1)=1.0_JPRB/ZMUE
403  PTRCLD(JL)=1.0_JPRB-ZC1I(JL,1)
404ENDDO
405
406!     ------------------------------------------------------------------
407
408!*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
409!                 -------------------------------------------------
410
411IF (NSW <= 4) THEN
412  INU1=1
413ELSEIF (NSW == 6) THEN
414  INU1=3
415ENDIF   
416
417IF (KNU <= INU1) THEN
418  JAJ = 2
419  DO JL = KIDIA,KFDIA
420    PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
421    PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
422  ENDDO
423
424  DO JK = 1 , KLEV
425    IKL = KLEV+1 - JK
426    IKLP1 = IKL + 1
427    DO JL = KIDIA,KFDIA
428      ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,  1,IKL)
429      PRJ(JL,JAJ,IKL) = ZRE11
430      PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,  1,IKL)
431    ENDDO
432  ENDDO
433
434ELSE
435
436  DO JAJ = 1 , 2
437    DO JL = KIDIA,KFDIA
438      PRJ(JL,JAJ,KLEV+1) = 1.0_JPRB
439      PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
440    ENDDO
441
442    DO JK = 1 , KLEV
443      IKL = KLEV+1 - JK
444      IKLP1 = IKL + 1
445      DO JL = KIDIA,KFDIA
446        ZRE11= PRJ(JL,JAJ,IKLP1) * ZTR(JL,JAJ,IKL)
447        PRJ(JL,JAJ,IKL) = ZRE11
448        PRK(JL,JAJ,IKL) = ZRE11 * PREFZ(JL,JAJ,IKL)
449      ENDDO
450    ENDDO
451  ENDDO
452
453ENDIF
454IF(LLDEBUG) THEN
455 call writefield_phy ('swr_zc1i',ZC1I,KLEV+1)
456 call writefield_phy ('swr_zss1',ZSS1,1)
457 call writefield_phy ('swr_zclear',ZCLEAR,1)
458 call writefield_phy ('swr_prmue',PRMUE,KLEV+1)
459 call writefield_phy ('swr_psec',PSEC,1)
460 call writefield_phy ('swr_prmue',PRMUE,KLEV+1)
461 call writefield_phy ('swr_ppizaz',PPIZAZ,KLEV)
462 call writefield_phy ('swr_pcgaz',PCGAZ,KLEV)
463 call writefield_phy ('swr_pcg',PCG,KLEV)
464 call writefield_phy ('swr_ptau',PTAU(:,1,:),KLEV)
465 call writefield_phy ('swr_ptauaz',PTAUAZ,KLEV)
466 call writefield_phy ('swr_pcld',PCLD,KLEV)
467ENDIF
468!     ------------------------------------------------------------------
469
470IF (LHOOK) CALL DR_HOOK('SWR',1,ZHOOK_HANDLE)
471END SUBROUTINE SWR
Note: See TracBrowser for help on using the repository browser.