source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phymar/sw1s.F90 @ 4031

Last change on this file since 4031 was 3990, checked in by millour, 8 years ago

An updated LMDZ5 (based on LMDZ rev 2786) to play with.
EM
File size: 10.5 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 &
6 &)
7
8!**** *SW1S* - SHORTWAVE RADIATION, FIRST SPECTRAL INTERVAL
9
10!     PURPOSE.
11!     --------
12
13!          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
14!     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
15
16!**   INTERFACE.
17!     ----------
18
19!          *SW1S* IS CALLED FROM *SW*.
20
21
22!        IMPLICIT ARGUMENTS :
23!        --------------------
24
25!     ==== INPUTS ===
26!     ==== OUTPUTS ===
27
28!     METHOD.
29!     -------
30
31!          1. COMPUTES QUANTITIES FOR THE CLEAR-SKY FRACTION OF THE
32!     COLUMN
33!          2. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
34!     CONTINUUM SCATTERING
35!          3. MULTIPLY BY OZONE TRANSMISSION FUNCTION
36
37!     EXTERNALS.
38!     ----------
39
40!          *SWCLR*, *SWR*, *SWTT*, *SWUVO3*
41
42!     REFERENCE.
43!     ----------
44
45!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
46!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
47
48!     AUTHOR.
49!     -------
50!        JEAN-JACQUES MORCRETTE  *ECMWF*
51
52!     MODIFICATIONS.
53!     --------------
54!        ORIGINAL : 89-07-14
55!        94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
56!        96-01-15   J.-J. MORCRETTE    SW in nsw SPECTRAL INTERVALS
57!        990128     JJMorcrette        sunshine duration
58!        99-05-25   JJMorcrette        Revised aerosols
59!        00-12-18   JJMorcrette        6 spectral intervals
60
61!     ------------------------------------------------------------------
62
63
64#include "tsmbkind.h"
65
66USE YOESW    , ONLY : RRAY     ,RSUN
67USE YOERAD   , ONLY : NSW
68
69
70IMPLICIT NONE
71
72
73!     DUMMY INTEGER SCALARS
74INTEGER_M :: KAER
75INTEGER_M :: KFDIA
76INTEGER_M :: KIDIA
77INTEGER_M :: KKIND
78INTEGER_M :: KLEV
79INTEGER_M :: KLON
80INTEGER_M :: KNU
81
82
83
84!     ------------------------------------------------------------------
85
86!*       0.1   ARGUMENTS
87!              ---------
88
89REAL_B :: PAER(KLON,6,KLEV)&
90  &,  PALBD(KLON,NSW)      , PALBP(KLON,NSW)&
91  &,  PCG(KLON,NSW,KLEV)   , PCLD(KLON,KLEV) &
92  &,  PCLEAR(KLON)&
93  &,  PDSIG(KLON,KLEV)&
94  &,  POMEGA(KLON,NSW,KLEV), POZ(KLON,KLEV)&
95  &,  PRMU(KLON)           , PSEC(KLON)&
96  &,  PTAU(KLON,NSW,KLEV)  , PUD(KLON,5,KLEV+1)
97
98REAL_B :: PFD(KLON,KLEV+1) , PFU(KLON,KLEV+1)&
99  &,  PCD(KLON,KLEV+1)     , PCU(KLON,KLEV+1)&
100  &,  PSUDU1(KLON)
101
102!     ------------------------------------------------------------------
103
104!*       0.2   LOCAL ARRAYS
105!              ------------
106
107INTEGER_M :: IIND6(6), IIND4(4)
108
109REAL_B :: ZCGAZ(KLON,KLEV)&
110  &,  ZDIFF(KLON)        , ZDIRF(KLON)        &
111  &,  ZDIFT(KLON)        , ZDIRT(KLON)        &
112  &,  ZPIZAZ(KLON,KLEV)&
113  &,  ZRAYL(KLON), ZRAY1(KLON,KLEV+1), ZRAY2(KLON,KLEV+1)&
114  &,  ZREFZ(KLON,2,KLEV+1)&
115  &,  ZRJ(KLON,6,KLEV+1), ZRJ0(KLON,6,KLEV+1)&
116  &,  ZRK(KLON,6,KLEV+1), ZRK0(KLON,6,KLEV+1)&
117  &,  ZRMUE(KLON,KLEV+1), ZRMU0(KLON,KLEV+1)&
118  &,  ZR6(KLON,6)       , ZR4(KLON,4)&
119  &,  ZTAUAZ(KLON,KLEV)&
120  &,  ZTRA1(KLON,KLEV+1), ZTRA2(KLON,KLEV+1)&
121  &,  ZTRCLD(KLON)      , ZTRCLR(KLON)&
122  &,  ZW6(KLON,6)       , ZW4(KLON,4), ZO(KLON,2) ,ZT(KLON,2)
123
124!     LOCAL INTEGER SCALARS
125INTEGER_M :: IKL, IKM1, JAJ, JK, JL
126
127
128!     ------------------------------------------------------------------
129
130!*         1.     FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
131!                 ----------------------- ------------------
132
133
134!*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
135!                 -----------------------------------------
136
137
138DO JL = KIDIA,KFDIA
139  ZRAYL(JL) =  RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)&
140   &* (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)&
141   &* (RRAY(KNU,5) + PRMU(JL) *  RRAY(KNU,6)       ))))
142ENDDO
143!print *,'SW1S After Rayleigh'
144
145
146!     ------------------------------------------------------------------
147
148!*         2.    CONTINUUM SCATTERING CALCULATIONS
149!                ---------------------------------
150
151
152!*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
153!                --------------------------------
154
155
156CALL SWCLR &
157  &( KIDIA  , KFDIA , KLON  , KLEV , KAER , KNU &
158  &, PAER   , PALBP , PDSIG , ZRAYL, PSEC &
159  &, ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 &
160  &, ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2, ZTRCLR &
161  &)
162!print *,'SW1S After SWCLR'
163
164
165!*         2.2   CLOUDY FRACTION OF THE COLUMN
166!                -----------------------------
167
168
169CALL SWR &
170  &( KIDIA ,KFDIA ,KLON  ,KLEV  , KNU &
171  &, PALBD ,PCG   ,PCLD  ,POMEGA, PSEC , PTAU &
172  &, ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 , ZREFZ, ZRJ  ,ZRK , ZRMUE &
173  &, ZTAUAZ,ZTRA1 ,ZTRA2 ,ZTRCLD &
174  &)
175!print *,'SW1S After SWR'
176
177
178!     ------------------------------------------------------------------
179
180!*         3.    OZONE ABSORPTION
181!                ----------------
182
183IF (NSW <= 4) THEN
184
185!*         3.1   TWO OR FOUR SPECTRAL INTERVALS
186!                ------------------------------
187
188  IIND6(1)=1
189  IIND6(2)=2
190  IIND6(3)=3
191  IIND6(4)=1
192  IIND6(5)=2
193  IIND6(6)=3
194
195
196!*         3.1.1  DOWNWARD FLUXES
197!                 ---------------
198
199
200  JAJ = 2
201
202  DO JL = KIDIA,KFDIA
203    ZW6(JL,1)=_ZERO_
204    ZW6(JL,2)=_ZERO_
205    ZW6(JL,3)=_ZERO_
206    ZW6(JL,4)=_ZERO_
207    ZW6(JL,5)=_ZERO_
208    ZW6(JL,6)=_ZERO_
209    PFD(JL,KLEV+1)=((_ONE_-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
210     &+ PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU)
211    PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
212  ENDDO
213  DO JK = 1 , KLEV
214    IKL = KLEV+1-JK
215    DO JL = KIDIA,KFDIA
216      ZW6(JL,1)=ZW6(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
217      ZW6(JL,2)=ZW6(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL)
218      ZW6(JL,3)=ZW6(JL,3)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
219      ZW6(JL,4)=ZW6(JL,4)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
220      ZW6(JL,5)=ZW6(JL,5)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
221      ZW6(JL,6)=ZW6(JL,6)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
222    ENDDO
223   
224    KKIND=6
225    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, KKIND &
226      &, IIND6 &
227      &, ZW6  &
228      &, ZR6                          )
229
230    DO JL = KIDIA,KFDIA
231      ZDIFF(JL) = ZR6(JL,1)*ZR6(JL,2)*ZR6(JL,3)*ZRJ(JL,JAJ,IKL)
232      ZDIRF(JL) = ZR6(JL,4)*ZR6(JL,5)*ZR6(JL,6)*ZRJ0(JL,JAJ,IKL)
233      PFD(JL,IKL) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)&
234       &+PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
235      PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
236    ENDDO
237  ENDDO
238
239  DO JL=KIDIA,KFDIA
240    ZDIFT(JL) = ZR6(JL,1)*ZR6(JL,2)*ZR6(JL,3)*ZTRCLD(JL)
241    ZDIRT(JL) = ZR6(JL,4)*ZR6(JL,5)*ZR6(JL,6)*ZTRCLR(JL)
242    PSUDU1(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFT(JL)&
243     &+PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU)
244  ENDDO
245
246
247!*         3.1.2  UPWARD FLUXES
248!                 -------------
249
250
251  DO JL = KIDIA,KFDIA
252    PFU(JL,1) = ((_ONE_-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)&
253     &+ PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))&
254     &* RSUN(KNU)
255    PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU)
256  ENDDO
257
258  DO JK = 2 , KLEV+1
259    IKM1=JK-1
260    DO JL = KIDIA,KFDIA
261      ZW6(JL,1)=ZW6(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
262      ZW6(JL,2)=ZW6(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
263      ZW6(JL,3)=ZW6(JL,3)+POZ(JL,  IKM1)*1.66_JPRB
264      ZW6(JL,4)=ZW6(JL,4)+PUD(JL,1,IKM1)*1.66_JPRB
265      ZW6(JL,5)=ZW6(JL,5)+PUD(JL,2,IKM1)*1.66_JPRB
266      ZW6(JL,6)=ZW6(JL,6)+POZ(JL,  IKM1)*1.66_JPRB
267    ENDDO
268   
269    KKIND=6
270    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, KKIND &
271      &, IIND6 &
272      &, ZW6  &
273      &, ZR6                          )
274 
275    DO JL = KIDIA,KFDIA
276      ZDIFF(JL) = ZR6(JL,1)*ZR6(JL,2)*ZR6(JL,3)*ZRK(JL,JAJ,JK)
277      ZDIRF(JL) = ZR6(JL,4)*ZR6(JL,5)*ZR6(JL,6)*ZRK0(JL,JAJ,JK)
278      PFU(JL,JK) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)&
279       &+PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
280      PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU)
281    ENDDO
282  ENDDO
283
284
285
286
287ELSE IF (NSW == 6) THEN
288!print *,'SW1S ozone 6SI'
289
290!*         3.2   SIX SPECTRAL INTERVALS
291!                ----------------------
292
293  IIND4(1)=1
294  IIND4(2)=2
295  IIND4(3)=1
296  IIND4(4)=2
297
298
299!*         3.2,1  DOWNWARD FLUXES
300!                 ---------------
301
302
303  JAJ = 2
304
305  DO JL = KIDIA,KFDIA
306    ZW4(JL,1)=_ZERO_
307    ZW4(JL,2)=_ZERO_
308    ZW4(JL,3)=_ZERO_
309    ZW4(JL,4)=_ZERO_
310 
311    ZO(JL,1)=_ZERO_
312    ZO(JL,2)=_ZERO_
313    PFD(JL,KLEV+1)=((_ONE_-PCLEAR(JL))*ZRJ(JL,JAJ,KLEV+1)&
314      &+ PCLEAR(JL) *ZRJ0(JL,JAJ,KLEV+1)) * RSUN(KNU)
315    PCD(JL,KLEV+1)= ZRJ0(JL,JAJ,KLEV+1) * RSUN(KNU)
316  ENDDO
317  DO JK = 1 , KLEV
318    IKL = KLEV+1-JK
319    DO JL = KIDIA,KFDIA
320      ZW4(JL,1)=ZW4(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
321      ZW4(JL,2)=ZW4(JL,2)+PUD(JL,2,IKL)/ZRMUE(JL,IKL)
322      ZW4(JL,3)=ZW4(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
323      ZW4(JL,4)=ZW4(JL,4)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
324   
325      ZO(JL,1)=ZO(JL,1)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
326      ZO(JL,2)=ZO(JL,2)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
327    ENDDO
328 
329    KKIND=4
330    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, KKIND &
331      &, IIND4 &
332      &, ZW4  &
333      &, ZR4  &
334      & )
335!    print *,'SW1S after SWTT1 JK=',JK 
336
337    KKIND=2
338    CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, KKIND &
339      &, ZO  &
340      &, ZT  &
341      & )
342!    print *,'SW1S after SWUVO3 JK=',JK
343
344    DO JL = KIDIA,KFDIA
345      ZDIFF(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZRJ(JL,JAJ,IKL)
346      ZDIRF(JL) = ZR4(JL,3)*ZR4(JL,4)*ZT(JL,2)*ZRJ0(JL,JAJ,IKL)
347      PFD(JL,IKL) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)&
348        &+PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
349      PCD(JL,IKL) = ZDIRF(JL) * RSUN(KNU)
350    ENDDO
351  ENDDO
352
353  DO JL=KIDIA,KFDIA
354    ZDIFT(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZTRCLD(JL)
355    ZDIRT(JL) = ZR4(JL,3)*ZR4(JL,4)*ZT(JL,2)*ZTRCLR(JL)
356    PSUDU1(JL) = ((_ONE_-PCLEAR(JL)) * ZDIFT(JL)&
357      &+PCLEAR(JL) * ZDIRT(JL)) * RSUN(KNU)
358  ENDDO
359
360
361!*         3.2.2  UPWARD FLUXES
362!                 -------------
363
364
365  DO JL = KIDIA,KFDIA
366    PFU(JL,1) = ((_ONE_-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)&
367      &+ PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))&
368      &* RSUN(KNU)
369    PCU(JL,1) = ZDIRF(JL) * PALBP(JL,KNU) * RSUN(KNU)
370  ENDDO
371
372  DO JK = 2 , KLEV+1
373    IKM1=JK-1
374    DO JL = KIDIA,KFDIA
375      ZW4(JL,1)=ZW4(JL,1)+PUD(JL,1,IKM1)*1.66_JPRB
376      ZW4(JL,2)=ZW4(JL,2)+PUD(JL,2,IKM1)*1.66_JPRB
377      ZW4(JL,3)=ZW4(JL,3)+PUD(JL,1,IKM1)*1.66_JPRB
378      ZW4(JL,4)=ZW4(JL,4)+PUD(JL,2,IKM1)*1.66_JPRB
379     
380      ZO(JL,1)=ZO(JL,1)+POZ(JL,  IKM1)*1.66_JPRB
381      ZO(JL,2)=ZO(JL,2)+POZ(JL,  IKM1)*1.66_JPRB
382    ENDDO
383
384    KKIND=4
385    CALL SWTT1 ( KIDIA, KFDIA, KLON, KNU, KKIND &
386      &, IIND4 &
387      &, ZW4  &
388      &, ZR4  &
389      & )
390
391    KKIND=2
392    CALL SWUVO3 ( KIDIA, KFDIA, KLON, KNU, KKIND &
393      &, ZO  &
394      &, ZT  &
395      & )
396
397    DO JL = KIDIA,KFDIA
398      ZDIFF(JL) = ZR4(JL,1)*ZR4(JL,2)*ZT(JL,1)*ZRK(JL,JAJ,JK)
399      ZDIRF(JL) = ZR4(JL,3)*ZR4(JL,4)*ZT(JL,2)*ZRK0(JL,JAJ,JK)
400      PFU(JL,JK) = ((_ONE_-PCLEAR(JL)) * ZDIFF(JL)&
401        &+PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
402      PCU(JL,JK) = ZDIRF(JL) * RSUN(KNU)
403    ENDDO
404  ENDDO
405 
406END IF 
407
408!     ------------------------------------------------------------------
409
410RETURN
411END SUBROUTINE SW1S
Note: See TracBrowser for help on using the repository browser.