LMDZ
swclr.F90
Go to the documentation of this file.
1 SUBROUTINE 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 
63 USE parkind1 ,ONLY : jpim ,jprb
64 USE yomhook ,ONLY : lhook, dr_hook
65 
66 USE yoesw , ONLY : rtaua ,rpiza ,rcga
67 !USE YOERAD , ONLY : NOVLP ,NSW
68 ! NSW mis dans .def MPL 20140211
69 USE yoerad , ONLY : novlp
70 USE yoerdi , ONLY : repclc
71 USE yoerdu , ONLY : repsct
72 
73 IMPLICIT NONE
74 include "clesphys.h"
75 
76 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
77 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
78 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
79 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
80 INTEGER(KIND=JPIM),INTENT(IN) :: KAER
81 INTEGER(KIND=JPIM),INTENT(IN) :: KNU
82 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(klon,6,klev)
83 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(klon,nsw)
84 REAL(KIND=JPRB) ,INTENT(IN) :: PDSIG(klon,klev)
85 REAL(KIND=JPRB) ,INTENT(IN) :: PRAYL(klon)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PSEC(klon)
87 !++MODIFCODE
88 LOGICAL ,INTENT(IN) :: LDDUST ! flag for DUST
89 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(klon,klev)
90 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(klon,klev)
91 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_DST(klon,klev)
92 !--MODIFCODE
93 REAL(KIND=JPRB) ,INTENT(OUT) :: PCGAZ(klon,klev)
94 REAL(KIND=JPRB) ,INTENT(OUT) :: PPIZAZ(klon,klev)
95 REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY1(klon,klev+1)
96 REAL(KIND=JPRB) ,INTENT(OUT) :: PRAY2(klon,klev+1)
97 REAL(KIND=JPRB) ,INTENT(OUT) :: PREFZ(klon,2,klev+1)
98 REAL(KIND=JPRB) ,INTENT(OUT) :: PRJ(klon,6,klev+1)
99 REAL(KIND=JPRB) ,INTENT(OUT) :: PRK(klon,6,klev+1)
100 REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU0(klon,klev+1)
101 REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAZ(klon,klev)
102 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA1(klon,klev+1)
103 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRA2(klon,klev+1)
104 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRCLR(klon)
105 ! ------------------------------------------------------------------
106 
107 !* 0.1 ARGUMENTS
108 ! ---------
109 
110 ! ------------------------------------------------------------------
111 
112 ! ------------
113 
114 REAL(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 
120 INTEGER(KIND=JPIM) :: IKL, JA, JAE, JAJ, JK, JKL, JKLP1, JKM1, JL, INU1
121 
122 REAL(KIND=JPRB) :: ZBMU0, ZBMU1, ZCORAE, ZDEN, ZDEN1, ZFACOA,&
123  & ZFF, ZGAP, ZGAR, ZMU1, ZMUE, ZRATIO, ZRE11, &
124  & ZTO, ZTRAY, ZWW, ZDENB
125 REAL(KIND=JPRB) :: ZRR,ZMU0,ZI2MU1,ZIMU1,ZIDEN,ZIDEN1
126 REAL(KIND=JPRB) :: ZHOOK_HANDLE
127 !++MODIFCODE
128 REAL(KIND=JPRB) ::ZFACOA_NEW(klon,klev)
129 !--MODIFCODE
130 
131 
132 ! ------------------------------------------------------------------
133 
134 !* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
135 ! --------------------------------------------
136 
137 IF (lhook) CALL dr_hook('SWCLR',0,zhook_handle)
138 DO 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
145 ENDDO
146 
147 ! ------ NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
148 
149 DO 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 
277 ENDDO
278 
279 ! ------------------------------------------------------------------
280 
281 !* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
282 ! ----------------------------------------------
283 
284 DO 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
289 ENDDO
290 
291 jk = 1
292 jkl = klev+1 - jk
293 jklp1 = jkl + 1
294 DO 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
327 ENDDO
328 
329 DO 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
366 ENDDO
367 
368 ! ------------------------------------------------------------------
369 
370 !* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
371 ! -----------------------------------------------
372 
373 DO 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
380 ENDDO
381 
382 DO 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
436 ENDDO
437 DO 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)
441 ENDDO
442 
443 ! ------------------------------------------------------------------
444 
445 !* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
446 ! -------------------------------------------------
447 
448 IF (nsw <= 4) THEN
449  inu1=1
450 ELSEIF (nsw == 6) THEN
451  inu1=3
452 ENDIF
453 
454 IF (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 
471 ELSE
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 
490 ENDIF
491 
492 ! ------------------------------------------------------------------
493 
494 IF (lhook) CALL dr_hook('SWCLR',1,zhook_handle)
495 END SUBROUTINE swclr
swclr
subroutine swclr(KIDIA, KFDIA, KLON, KLEV, KAER, KNU, PAER, PALBP, PDSIG, PRAYL, PSEC, PCGAZ, PPIZAZ, PRAY1, PRAY2, PREFZ, PRJ, PRK, PRMU0, PTAUAZ, PTRA1, PTRA2, PTRCLR,
Definition: swclr.F90:7
yoesw
Definition: yoesw.F90:1
dimphy::kidia
integer, save kidia
Definition: dimphy.F90:6
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
yoerad::novlp
integer(kind=jpim) novlp
Definition: yoerad.F90:24
yoerdu::repsct
real(kind=jprb) repsct
Definition: yoerdu.F90:23
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
yoerdi
Definition: yoerdi.F90:1
dimphy::kfdia
integer, save kfdia
Definition: dimphy.F90:5
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
yoerad
Definition: yoerad.F90:1
yoesw::rtaua
real(kind=jprb), dimension(6, 6) rtaua
Definition: yoesw.F90:115
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
yoesw::rcga
real(kind=jprb), dimension(6, 6) rcga
Definition: yoesw.F90:117
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
yoesw::rpiza
real(kind=jprb), dimension(6, 6) rpiza
Definition: yoesw.F90:116
paer
INTERFACE SUBROUTINE RRTM_ECRT_140GP && paer
Definition: rrtm_ecrt_140gp.intfb.h:3
yoerdi::repclc
real(kind=jprb) repclc
Definition: yoerdi.F90:21
yoerdu
Definition: yoerdu.F90:1