source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/sw1s.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • 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
Line 
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
74USE write_field_phy
75
76IMPLICIT NONE
77
78include "clesphys.h"
79
80INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
81INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
82INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
83INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
84INTEGER(KIND=JPIM),INTENT(IN)    :: KAER
85INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
87REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
88REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW)
89REAL(KIND=JPRB)   ,INTENT(IN)    :: PCG(KLON,NSW,KLEV)
90REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLD(KLON,KLEV)
91REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLEAR(KLON)
92REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSIG(KLON,KLEV)
93REAL(KIND=JPRB)   ,INTENT(IN)    :: POMEGA(KLON,NSW,KLEV)
94REAL(KIND=JPRB)   ,INTENT(IN)    :: POZ(KLON,KLEV)
95REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU(KLON)
96REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC(KLON)
97REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU(KLON,NSW,KLEV)
98REAL(KIND=JPRB)   ,INTENT(IN)    :: PUD(KLON,5,KLEV+1)
99!++MODIFCODE
100LOGICAL           ,INTENT(IN)    :: LRDUST          ! flag for DUST
101REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV)
102REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV)
103REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV)
104!--MODIFCODE
105REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFD(KLON,KLEV+1)
106REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFU(KLON,KLEV+1)
107REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCD(KLON,KLEV+1)
108REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCU(KLON,KLEV+1)
109REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU1(KLON)
110REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIFF(KLON,KLEV)
111REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIRF(KLON,KLEV)
112!     ------------------------------------------------------------------
113
114!*       0.1   ARGUMENTS
115!              ---------
116
117!     ------------------------------------------------------------------
118
119!              ------------
120
121INTEGER(KIND=JPIM) :: IIND(6)
122
123REAL(KIND=JPRB) :: ZCGAZ(KLON,KLEV)&
124 & ,  ZDIFF(KLON)        , ZDIRF(KLON)        &
125 & ,  ZDIFT(KLON)        , ZDIRT(KLON)        &
126 & ,  ZPIZAZ(KLON,KLEV)&
127 & ,  ZRAYL(KLON), ZRAY1(KLON,KLEV+1), ZRAY2(KLON,KLEV+1)&
128 & ,  ZREFZ(KLON,2,KLEV+1)&
129 & ,  ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)&
130 & ,  ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)&
131 & ,  ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1)&
132 & ,  ZR(KLON,6)&
133 & ,  ZTAUAZ(KLON,KLEV)&
134 & ,  ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)&
135 & ,  ZTRCLD(KLON)      , ZTRCLR(KLON)&
136 & ,  ZW(KLON,6)        , ZO(KLON,2) ,ZT(KLON,2)   
137
138INTEGER(KIND=JPIM) :: IKL, IKM1, JAJ, JK, JL , JJ
139REAL(KIND=JPRB) :: ZHOOK_HANDLE
140LOGICAL         :: LLDEBUG
141
142#include "swclr.intfb.h"
143#include "swr.intfb.h"
144#include "swtt1.intfb.h"
145#include "swuvo3.intfb.h"
146
147!     ------------------------------------------------------------------
148
149!*         1.     FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
150!                 ----------------------- ------------------
151
152!*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
153!                 -----------------------------------------
154
155IF (LHOOK) CALL DR_HOOK('SW1S',0,ZHOOK_HANDLE)
156LLDEBUG=.FALSE.
157DO JL = KIDIA,KFDIA
158  ZRAYL(JL) =  RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)&
159   & * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)&
160   & * (RRAY(KNU,5) + PRMU(JL) *  RRAY(KNU,6)       )))) 
161ENDDO
162!     ------------------------------------------------------------------
163
164!*         2.    CONTINUUM SCATTERING CALCULATIONS
165!                ---------------------------------
166
167!*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
168!                --------------------------------
169
170!++MODIFCODE
171CALL SWCLR &
172   &( KIDIA  , KFDIA , KLON  , KLEV , KAER , KNU &
173   &, PAER   , PALBP , PDSIG , ZRAYL, PSEC &
174   &, ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 &
175   &, ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR &
176   &, LRDUST , PPIZA_DST,PCGA_DST  &
177   &, PTAUREL_DST )
178
179!--MODIFCODE
180
181!*         2.2   CLOUDY FRACTION OF THE COLUMN
182!                -----------------------------
183
184CALL SWR &
185 & ( KIDIA ,KFDIA ,KLON  ,KLEV  , KNU,&
186 & PALBD ,PCG   ,PCLD  ,POMEGA, PSEC , PTAU,&
187 & ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 , ZREFZ, ZRJ  ,ZRK , ZRMUE,&
188 & ZTAUAZ,ZTRA1 ,ZTRA2 ,ZTRCLD &
189 & ) 
190
191! DO JK = 1 , KLEV
192!   IKL = KLEV+1-JK
193!   DO JL = KIDIA,KFDIA
194!   print *,'Apres SWCLR,SWR RMU0 RMUE ',ZRMU0(JL,IKL),ZRMUE(JL,IKL)
195!   ENDDO
196! ENDDO
197!     ------------------------------------------------------------------
198
199!*         3.    OZONE ABSORPTION
200!                ----------------
201
202IF (NSW <= 4) THEN
203
204!*         3.1   TWO OR FOUR SPECTRAL INTERVALS
205!                ------------------------------
206
207  IIND(1)=1
208  IIND(2)=2
209  IIND(3)=3
210  IIND(4)=1
211  IIND(5)=2
212  IIND(6)=3
213
214!*         3.1.1  DOWNWARD FLUXES
215!                 ---------------
216
217  JAJ = 2
218
219  DO JL = KIDIA,KFDIA
220    ZW(JL,1)=0.0_JPRB
221    ZW(JL,2)=0.0_JPRB
222    ZW(JL,3)=0.0_JPRB
223    ZW(JL,4)=0.0_JPRB
224    ZW(JL,5)=0.0_JPRB
225    ZW(JL,6)=0.0_JPRB
226    PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
227     & + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) 
228    PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
229  ENDDO
230  DO JK = 1 , KLEV
231    IKL = KLEV+1-JK
232    DO JL = KIDIA,KFDIA
233      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
234      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL)
235      ZW(JL,3)=ZW(JL,3)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
236      ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
237      ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
238      ZW(JL,6)=ZW(JL,6)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
239    ENDDO
240   
241    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,&
242     & IIND,&
243     & ZW,&
244     & ZR                          ) 
245
246    DO JL = KIDIA,KFDIA
247      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRJ(JL,JAJ,IKL)
248      ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRJ0(JL,JAJ,IKL)
249      PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL))
250      PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL)
251      PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
252       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
253      PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
254    ENDDO
255  ENDDO
256
257  DO JL=KIDIA,KFDIA
258    ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZTRCLD(JL)
259    ZDIRT(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZTRCLR(JL)
260    PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)&
261     & +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) 
262  ENDDO
263
264!*         3.1.2  UPWARD FLUXES
265!                 -------------
266
267  DO JL = KIDIA,KFDIA
268    PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)&
269     & + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))&
270     & * RSUN(KNU) 
271    PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU)
272  ENDDO
273
274  DO JK = 2 , KLEV+1
275    IKM1=JK-1
276    DO JL = KIDIA,KFDIA
277      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
278      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
279      ZW(JL,3)=ZW(JL,3)+POZ(JL,  IKM1)*1.66_JPRB
280      ZW(JL,4)=ZW(JL,4)+PUD(JL,1,IKM1)*1.66_JPRB
281      ZW(JL,5)=ZW(JL,5)+PUD(JL,2,IKM1)*1.66_JPRB
282      ZW(JL,6)=ZW(JL,6)+POZ(JL,  IKM1)*1.66_JPRB
283    ENDDO
284   
285    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 6,&
286     & IIND,&
287     & ZW,&
288     & ZR                          ) 
289 
290    DO JL = KIDIA,KFDIA
291      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZR(JL,3)*ZRK(JL,JAJ,JK)
292      ZDIRF(JL) = ZR(JL,4)*ZR(JL,5)*ZR(JL,6)*ZRK0(JL,JAJ,JK)
293      PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
294       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
295      PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU)
296    ENDDO
297!WRITE(*,'("---> Dans SW1S:")')
298!WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1)
299!WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1))
300!WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1))
301!WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1))
302!WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU))
303  ENDDO
304
305ELSEIF (NSW == 6) THEN
306print *,'... dans SW1S: NSW=',NSW
307
308!*         3.2   SIX SPECTRAL INTERVALS
309!                ----------------------
310
311  IIND(1)=1
312  IIND(2)=2
313  IIND(3)=1
314  IIND(4)=2
315
316!*         3.2,1  DOWNWARD FLUXES
317!                 ---------------
318
319  JAJ = 2
320
321  DO JL = KIDIA,KFDIA
322    ZW(JL,1)=0.0_JPRB
323    ZW(JL,2)=0.0_JPRB
324    ZW(JL,3)=0.0_JPRB
325    ZW(JL,4)=0.0_JPRB
326 
327    ZO(JL,1)=0.0_JPRB
328    ZO(JL,2)=0.0_JPRB
329    PFD(JL,KLEV+1)=((1.0_JPRB-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
330     & + PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU) 
331    PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
332  ENDDO
333  DO JK = 1 , KLEV
334    IKL = KLEV+1-JK
335    DO JL = KIDIA,KFDIA
336      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
337      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL)
338      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
339      ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
340   
341      ZO(JL,1)=ZO(JL,1)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
342      ZO(JL,2)=ZO(JL,2)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
343    ENDDO
344 
345!   WRITE(*,'("---> Dans SW1S avant SWTT1:")')
346    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,&
347     & IIND,&
348     & ZW,&
349     & ZR  &
350     & ) 
351
352!   WRITE(*,'("---> Dans SW1S avant SWUVO3 flux dwn:")')
353    CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,&
354     & ZO,&
355     & ZT  &
356     & ) 
357
358    DO JL = KIDIA,KFDIA
359      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL)
360      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL)
361      PDIFF(JL,IKL) = ZDIFF(JL) * RSUN(KNU)*(1.0_JPRB-PCLEAR(JL))
362      PDIRF(JL,IKL) = ZDIRF(JL) * RSUN(KNU)*PCLEAR(JL)
363      PFD(JL,IKL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
364       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
365      PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
366    ENDDO
367  ENDDO
368
369  IF(LLDEBUG) THEN
370  call writefield_phy('sw1s_pud1',PUD(:,1,:),klev)
371  call writefield_phy('sw1s_pud2',PUD(:,2,:),klev)
372  call writefield_phy('sw1s_psec',PSEC,1)
373  call writefield_phy('sw1s_zrmue',ZRMUE,klev+1)
374  call writefield_phy('sw1s_zrmu0',ZRMU0,klev+1)
375  call writefield_phy('sw1s_pdirf',PDIRF,klev)
376  call writefield_phy('sw1s_pdiff',PDIFF,klev)
377  call writefield_phy('sw1s_pfd',PFD,klev)
378  ENDIF
379  DO JL=KIDIA,KFDIA
380    ZDIFT(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZTRCLD(JL)
381    ZDIRT(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZTRCLR(JL)
382    PSUDU1(JL) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFT(JL)&
383     & +PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU) 
384  ENDDO
385
386!*         3.2.2  UPWARD FLUXES
387!                 -------------
388
389  DO JL = KIDIA,KFDIA
390    PFU(JL,1) = ((1.0_JPRB-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)&
391     & + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))&
392     & * RSUN(KNU) 
393    PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU)
394  ENDDO
395
396  DO JK = 2 , KLEV+1
397    IKM1=JK-1
398    DO JL = KIDIA,KFDIA
399      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
400      ZW(JL,2)=ZW(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
401      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66_JPRB
402      ZW(JL,4)=ZW(JL,4)+PUD(JL,2,IKM1)*1.66_JPRB
403     
404      ZO(JL,1)=ZO(JL,1)+POZ(JL,  IKM1)*1.66_JPRB
405      ZO(JL,2)=ZO(JL,2)+POZ(JL,  IKM1)*1.66_JPRB
406    ENDDO
407
408!   WRITE(*,'("---> Dans SW1S avant SWTT1:")')
409    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, 4,&
410     & IIND,&
411     & ZW,&
412     & ZR  &
413     & ) 
414
415!   WRITE(*,'("---> Dans SW1S avant SWUVO3 flux up:")')
416    CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, 2,&
417     & ZO,&
418     & ZT  &
419     & ) 
420
421    DO JL = KIDIA,KFDIA
422      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZT(JL,1)*ZRK(JL,JAJ,JK)
423      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZT(JL,2)*ZRK0(JL,JAJ,JK)
424      PFU(JL,JK) = ((1.0_JPRB-PCLEAR(JL)) * ZDIFF(JL)&
425       & +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU) 
426      PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU)
427!WRITE(*,'("---> Dans SW1S:")')
428!print *,'===JL= ',jl
429!WRITE(*,'("ZR1",10E12.5)') (ZR(JL,1))
430!WRITE(*,'("ZR2",10E12.5)') (ZR(JL,2))
431!WRITE(*,'("ZR3",10E12.5)') (ZR(JL,3))
432!WRITE(*,'("ZR4",10E12.5)') (ZR(JL,4))
433!WRITE(*,'("ZT1",10E12.5)') (ZT(JL,1))
434!WRITE(*,'("ZT2",10E12.5)') (ZT(JL,2))
435    ENDDO
436  ENDDO
437 
438!WRITE(*,'("---> Dans SW1S:")')
439!WRITE(*,'("PFU",10E12.5)') (PFU(1,JJ),JJ=1,KLEV+1)
440!WRITE(*,'("ZR",10E12.5)') (ZR(1,JJ),JJ=1,4)
441!WRITE(*,'("PCLEAR",10E12.5)') (PCLEAR(1))
442!WRITE(*,'("ZDIFF",10E12.5)') (ZDIFF(1))
443!WRITE(*,'("ZDIRF",10E12.5)') (ZDIRF(1))
444!WRITE(*,'("RSUN",10E12.5)') (RSUN(KNU))
445ENDIF 
446
447!     ------------------------------------------------------------------
448
449IF (LHOOK) CALL DR_HOOK('SW1S',1,ZHOOK_HANDLE)
450END SUBROUTINE SW1S
Note: See TracBrowser for help on using the repository browser.