source: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sw1s.F90 @ 5441

Last change on this file since 5441 was 5160, checked in by abarral, 5 months ago

Put .h into modules

  • 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: 13.7 KB
RevLine 
[1989]1SUBROUTINE SW1S &
2 & ( KIDIA , KFDIA , KLON , KLEV , KAER , KNU,&
3 & PAER  , PALBD , PALBP, PCG  , PCLD , PCLEAR,&
4 & PDSIG , POMEGA, POZ  , PRMU , PSEC , PTAU  , PUD,&
5 & PFD   , PFU   , PCD  , PCU  , PSUDU1,PDIFF , PDIRF, &
6!++MODIFCODE
7 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST  &
8!--MODIFCODE
9 &)
10
11!**** *SW1S* - SHORTWAVE RADIATION, FIRST SPECTRAL INTERVAL
12
13!     PURPOSE.
14!     --------
15
16!          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
17!     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
18
19!**   INTERFACE.
20!     ----------
21
22!          *SW1S* IS CALLED FROM *SW*.
23
24!        IMPLICIT ARGUMENTS :
25!        --------------------
26
27!     ==== INPUTS ===
28!     ==== OUTPUTS ===
29
30!     METHOD.
31!     -------
32
33!          1. COMPUTES QUANTITIES FOR THE CLEAR-SKY FRACTION OF THE
34!     COLUMN
35!          2. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
36!     CONTINUUM SCATTERING
37!          3. MULTIPLY BY OZONE TRANSMISSION FUNCTION
38
39!     EXTERNALS.
40!     ----------
41
42!          *SWCLR*, *SWR*, *SWTT*, *SWUVO3*
43
44!     REFERENCE.
45!     ----------
46
47!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
48!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
49
50!     AUTHOR.
51!     -------
52!        JEAN-JACQUES MORCRETTE  *ECMWF*
53
54!     MODIFICATIONS.
55!     --------------
56!        ORIGINAL : 89-07-14
57!        94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
58!        96-01-15   J.-J. MORCRETTE    SW in nsw SPECTRAL INTERVALS
59!        990128     JJMorcrette        sunshine duration
60!        99-05-25   JJMorcrette        Revised aerosols
61!        00-12-18   JJMorcrette        6 spectral intervals
62!        M.Hamrud      01-Oct-2003 CY28 Cleaning
63!        Y.Seity  04-11-19 : add two arguments for AROME externalized surface
64!        Y.Seity  05-10-10 : add 3 optional arg. for dust SW properties
65!        Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
66!     ------------------------------------------------------------------
67
68USE PARKIND1  ,ONLY : JPIM     ,JPRB
69USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
70
71USE YOESW    , ONLY : RRAY     ,RSUN
72!USE YOERAD   , ONLY : NSW
73! NSW mis dans .def MPL 20140211
[5133]74USE lmdz_writefield_phy, ONLY: writefield_phy
[5154]75USE lmdz_clesphys
[1989]76
77IMPLICIT NONE
78
79INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
80INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
81INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
82INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
83INTEGER(KIND=JPIM),INTENT(IN)    :: KAER
84INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
85REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
87REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW)
88REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG(KLON,NSW,KLEV)
89REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLD(KLON,KLEV)
90REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLEAR(KLON)
91REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSIG(KLON,KLEV)
92REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA(KLON,NSW,KLEV)
93REAL(KIND=JPRB)   ,INTENT(IN)    :: POZ(KLON,KLEV)
94REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU(KLON)
95REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC(KLON)
96REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU(KLON,NSW,KLEV)
97REAL(KIND=JPRB)   ,INTENT(IN)    :: PUD(KLON,5,KLEV+1)
98!++MODIFCODE
99LOGICAL           ,INTENT(IN)    :: LRDUST          ! flag for DUST
100REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV)
101REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV)
102REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV)
103!--MODIFCODE
104REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFD(KLON,KLEV+1)
105REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFU(KLON,KLEV+1)
106REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCD(KLON,KLEV+1)
107REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCU(KLON,KLEV+1)
108REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU1(KLON)
109REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIFF(KLON,KLEV)
110REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIRF(KLON,KLEV)
111!     ------------------------------------------------------------------
112
113!*       0.1   ARGUMENTS
114!              ---------
115
116!     ------------------------------------------------------------------
117
118!              ------------
119
120INTEGER(KIND=JPIM) :: IIND(6)
121
122REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV)&
123 & ,  ZDIFF(KLON)        , ZDIRF(KLON)        &
124 & ,  ZDIFT(KLON)        , ZDIRT(KLON)        &
125 & ,  ZPIZAZ(KLON,KLEV)&
126 & ,  ZRAYL(KLON), ZRAY1(KLON,KLEV+1), ZRAY2(KLON,KLEV+1)&
127 & ,  ZREFZ(KLON,2,KLEV+1)&
128 & ,  ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)&
129 & ,  ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)&
130 & ,  ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1)&
131 & ,  ZR(KLON,6)&
132 & ,  ZTAUAZ(KLON,KLEV)&
133 & ,  ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)&
134 & ,  ZTRCLD(KLON)      , ZTRCLR(KLON)&
135 & ,  ZW(KLON,6)        , ZO(KLON,2) ,ZT(KLON,2)   
136
137INTEGER(KIND=JPIM) :: IKL, IKM1, JAJ, JK, JL , JJ
138REAL(KIND=JPRB) :: ZHOOK_HANDLE
139LOGICAL         :: LLDEBUG
140
141#include "swclr.intfb.h"
142#include "swr.intfb.h"
143#include "swtt1.intfb.h"
144#include "swuvo3.intfb.h"
145
146!     ------------------------------------------------------------------
147
148!*         1.     FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
149!                 ----------------------- ------------------
150
151!*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
152!                 -----------------------------------------
153
154IF (LHOOK) CALL DR_HOOK('SW1S',0,ZHOOK_HANDLE)
155LLDEBUG=.FALSE.
156DO JL = KIDIA,KFDIA
157  ZRAYL(JL) =  RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)&
158   & * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)&
159   & * (RRAY(KNU,5) + PRMU(JL) *  RRAY(KNU,6)       )))) 
160ENDDO
161!     ------------------------------------------------------------------
162
163!*         2.    CONTINUUM SCATTERING CALCULATIONS
164!                ---------------------------------
165
166!*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
167!                --------------------------------
168
169!++MODIFCODE
170CALL SWCLR &
171   &( KIDIA  , KFDIA , KLON  , KLEV , KAER , KNU &
172   &, PAER   , PALBP , PDSIG , ZRAYL, PSEC &
173   &, ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 &
174   &, ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR &
175   &, LRDUST , PPIZA_DST,PCGA_DST  &
176   &, PTAUREL_DST )
177
178!--MODIFCODE
179
180!*         2.2   CLOUDY FRACTION OF THE COLUMN
181!                -----------------------------
182
183CALL SWR &
184 & ( KIDIA ,KFDIA ,KLON  ,KLEV  , KNU,&
185 & PALBD ,PCG   ,PCLD  ,POMEGA, PSEC , PTAU,&
186 & ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 , ZREFZ, ZRJ  ,ZRK , ZRMUE,&
187 & ZTAUAZ,ZTRA1 ,ZTRA2 ,ZTRCLD &
188 & ) 
189
190! DO JK = 1 , KLEV
191!   IKL = KLEV+1-JK
192!   DO JL = KIDIA,KFDIA
[5160]193!   PRINT *,'Apres SWCLR,SWR RMU0 RMUE ',ZRMU0(JL,IKL),ZRMUE(JL,IKL)
[1989]194!   ENDDO
195! ENDDO
196!     ------------------------------------------------------------------
197
198!*         3.    OZONE ABSORPTION
199!                ----------------
200
201IF (NSW <= 4) THEN
202
203!*         3.1   TWO OR FOUR SPECTRAL INTERVALS
204!                ------------------------------
205
206  IIND(1)=1
207  IIND(2)=2
208  IIND(3)=3
209  IIND(4)=1
210  IIND(5)=2
211  IIND(6)=3
212
213!*         3.1.1  DOWNWARD FLUXES
214!                 ---------------
215
216  JAJ = 2
217
218  DO JL = KIDIA,KFDIA
219    ZW(JL,1)=0.0_JPRB
220    ZW(JL,2)=0.0_JPRB
221    ZW(JL,3)=0.0_JPRB
222    ZW(JL,4)=0.0_JPRB
223    ZW(JL,5)=0.0_JPRB
224    ZW(JL,6)=0.0_JPRB
225    PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
226     & + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) 
227    PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
228  ENDDO
229  DO JK = 1 , KLEV
230    IKL = KLEV+1-JK
231    DO JL = KIDIA,KFDIA
232      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
233      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL)
234      ZW(JL,3)=ZW(JL,3)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
235      ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
236      ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
237      ZW(JL,6)=ZW(JL,6)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
238    ENDDO
239   
240    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,&
241     & IIND,&
242     & ZW,&
243     & ZR                          ) 
244
245    DO JL = KIDIA,KFDIA
246      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRJ(JL,JAJ,IKL)
247      ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRJ0(JL,JAJ,IKL)
248      PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL))
249      PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL)
250      PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
251       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
252      PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
253    ENDDO
254  ENDDO
255
256  DO JL=KIDIA,KFDIA
257    ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZTRCLD(JL)
258    ZDIRT(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZTRCLR(JL)
259    PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)&
260     & +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) 
261  ENDDO
262
263!*         3.1.2  UPWARD FLUXES
264!                 -------------
265
266  DO JL = KIDIA,KFDIA
267    PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)&
268     & + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))&
269     & * RSUN(KNU) 
270    PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU)
271  ENDDO
272
273  DO JK = 2 , KLEV+1
274    IKM1=JK-1
275    DO JL = KIDIA,KFDIA
276      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
277      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
278      ZW(JL,3)=ZW(JL,3)+POZ(JL,  IKM1)*1.66_JPRB
279      ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKM1)*1.66_JPRB
280      ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKM1)*1.66_JPRB
281      ZW(JL,6)=ZW(JL,6)+POZ(JL,  IKM1)*1.66_JPRB
282    ENDDO
283   
284    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,&
285     & IIND,&
286     & ZW,&
287     & ZR                          ) 
288 
289    DO JL = KIDIA,KFDIA
290      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRK(JL,JAJ,JK)
291      ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRK0(JL,JAJ,JK)
292      PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
293       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
294      PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU)
295    ENDDO
296!WRITE(*,'("---> Dans SW1S:")')
297!WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1)
298!WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1))
299!WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1))
300!WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1))
301!WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU))
302  ENDDO
303
304ELSEIF (NSW == 6) THEN
[5160]305!PRINT *,'... dans SW1S: NSW=',NSW
[1989]306
307!*         3.2   SIX SPECTRAL INTERVALS
308!                ----------------------
309
310  IIND(1)=1
311  IIND(2)=2
312  IIND(3)=1
313  IIND(4)=2
314
315!*         3.2,1  DOWNWARD FLUXES
316!                 ---------------
317
318  JAJ = 2
319
320  DO JL = KIDIA,KFDIA
321    ZW(JL,1)=0.0_JPRB
322    ZW(JL,2)=0.0_JPRB
323    ZW(JL,3)=0.0_JPRB
324    ZW(JL,4)=0.0_JPRB
325 
326    ZO(JL,1)=0.0_JPRB
327    ZO(JL,2)=0.0_JPRB
328    PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
329     & + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) 
330    PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
331  ENDDO
332  DO JK = 1 , KLEV
333    IKL = KLEV+1-JK
334    DO JL = KIDIA,KFDIA
335      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
336      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL)
337      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
338      ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
339   
340      ZO(JL,1)=ZO(JL,1)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
341      ZO(JL,2)=ZO(JL,2)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
342    ENDDO
343 
344!   WRITE(*,'("---> Dans SW1S avant SWTT1:")')
345    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,&
346     & IIND,&
347     & ZW,&
348     & ZR  &
349     & ) 
350
351!   WRITE(*,'("---> Dans SW1S avant SWUVO3 flux dwn:")')
352    CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,&
353     & ZO,&
354     & ZT  &
355     & ) 
356
357    DO JL = KIDIA,KFDIA
358      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL)
359      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL)
360      PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL))
361      PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL)
362      PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
363       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
364      PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
365    ENDDO
366  ENDDO
367
368  IF(LLDEBUG) THEN
369  call writefield_phy('sw1s_pud1',PUD(:,1,:),klev)
370  call writefield_phy('sw1s_pud2',PUD(:,2,:),klev)
371  call writefield_phy('sw1s_psec',PSEC,1)
372  call writefield_phy('sw1s_zrmue',ZRMUE,klev+1)
373  call writefield_phy('sw1s_zrmu0',ZRMU0,klev+1)
374  call writefield_phy('sw1s_pdirf',PDIRF,klev)
375  call writefield_phy('sw1s_pdiff',PDIFF,klev)
376  call writefield_phy('sw1s_pfd',PFD,klev)
377  ENDIF
378  DO JL=KIDIA,KFDIA
379    ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZTRCLD(JL)
380    ZDIRT(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZTRCLR(JL)
381    PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)&
382     & +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) 
383  ENDDO
384
385!*         3.2.2  UPWARD FLUXES
386!                 -------------
387
388  DO JL = KIDIA,KFDIA
389    PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)&
390     & + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))&
391     & * RSUN(KNU) 
392    PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU)
393  ENDDO
394
395  DO JK = 2 , KLEV+1
396    IKM1=JK-1
397    DO JL = KIDIA,KFDIA
398      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
399      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
400      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66_JPRB
401      ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKM1)*1.66_JPRB
402     
403      ZO(JL,1)=ZO(JL,1)+POZ(JL,  IKM1)*1.66_JPRB
404      ZO(JL,2)=ZO(JL,2)+POZ(JL,  IKM1)*1.66_JPRB
405    ENDDO
406
407!   WRITE(*,'("---> Dans SW1S avant SWTT1:")')
408    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,&
409     & IIND,&
410     & ZW,&
411     & ZR  &
412     & ) 
413
414!   WRITE(*,'("---> Dans SW1S avant SWUVO3 flux up:")')
415    CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,&
416     & ZO,&
417     & ZT  &
418     & ) 
419
420    DO JL = KIDIA,KFDIA
421      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRK(JL,JAJ,JK)
422      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRK0(JL,JAJ,JK)
423      PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
424       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
425      PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU)
426!WRITE(*,'("---> Dans SW1S:")')
[5160]427!PRINT *,'===JL= ',jl
[1989]428!WRITE(*,'("ZR1",10E12.5)') (ZR(JL,1))
429!WRITE(*,'("ZR2",10E12.5)') (ZR(JL,2))
430!WRITE(*,'("ZR3",10E12.5)') (ZR(JL,3))
431!WRITE(*,'("ZR4",10E12.5)') (ZR(JL,4))
432!WRITE(*,'("ZT1",10E12.5)') (ZT(JL,1))
433!WRITE(*,'("ZT2",10E12.5)') (ZT(JL,2))
434    ENDDO
435  ENDDO
436 
437!WRITE(*,'("---> Dans SW1S:")')
438!WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1)
439!WRITE(*,'("ZR",10E12.5)') (ZR(1,JJ),JJ=1,4)
440!WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1))
441!WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1))
442!WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1))
443!WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU))
444ENDIF 
445
446!     ------------------------------------------------------------------
447
448IF (LHOOK) CALL DR_HOOK('SW1S',1,ZHOOK_HANDLE)
449END SUBROUTINE SW1S
Note: See TracBrowser for help on using the repository browser.