source: LMDZ5/branches/Cold_pool_death/libf/phymar/swclr.F90 @ 5225

Last change on this file since 5225 was 2160, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

File size: 9.3 KB
Line 
1SUBROUTINE 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  &)
7
8!**** *SWCLR* - CLEAR-SKY COLUMN COMPUTATIONS
9
10!     PURPOSE.
11!     --------
12!           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
13!     CLEAR-SKY COLUMN
14
15!**   INTERFACE.
16!     ----------
17
18!          *SWCLR* 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
31!     EXTERNALS.
32!     ----------
33
34!          NONE
35
36!     REFERENCE.
37!     ----------
38
39!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
40!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
41
42!     AUTHOR.
43!     -------
44!        JEAN-JACQUES MORCRETTE  *ECMWF*
45
46!     MODIFICATIONS.
47!     --------------
48!        ORIGINAL : 94-11-15
49!        Modified : 96-03-19 JJM-PhD (loop 107 in absence of aerosols)
50!        JJMorcrette 990128 : sunshine duration
51!        JJMorcrette 990128 : sunshine duration
52!        99-05-25   JJMorcrette    Revised aerosols
53!        JJMorcrette 001218 : 6 spectral intervals
54   
55!     ------------------------------------------------------------------
56
57
58#include "tsmbkind.h"
59
60USE YOESW    , ONLY : RTAUA    ,RPIZA    ,RCGA
61USE YOERAD   , ONLY : NOVLP    ,NSW
62USE YOERDI   , ONLY : REPCLC
63USE YOERDU   , ONLY : REPSCT
64
65
66IMPLICIT NONE
67
68
69!     DUMMY INTEGER SCALARS
70INTEGER_M :: KAER
71INTEGER_M :: KFDIA
72INTEGER_M :: KIDIA
73INTEGER_M :: KLEV
74INTEGER_M :: KLON
75INTEGER_M :: KNU
76
77
78
79!     ------------------------------------------------------------------
80
81!*       0.1   ARGUMENTS
82!              ---------
83
84REAL_B :: PAER(KLON,6,KLEV), PALBP(KLON,NSW)&
85  &,  PDSIG(KLON,KLEV)&
86  &,  PRAYL(KLON)&
87  &,  PSEC(KLON)
88
89REAL_B ::&
90     &PCGAZ(KLON,KLEV)     &
91  &,  PPIZAZ(KLON,KLEV)&
92  &,  PRAY1(KLON,KLEV+1)  , PRAY2(KLON,KLEV+1)&
93  &,  PREFZ(KLON,2,KLEV+1), PRJ(KLON,6,KLEV+1)&
94  &,  PRK(KLON,6,KLEV+1)  , PRMU0(KLON,KLEV+1)&
95  &,  PTAUAZ(KLON,KLEV)&
96  &,  PTRA1(KLON,KLEV+1)  , PTRA2(KLON,KLEV+1)&
97  &,  PTRCLR(KLON)
98
99!     ------------------------------------------------------------------
100
101!*       0.2   LOCAL ARRAYS
102!              ------------
103
104REAL_B :: ZC0I(KLON,KLEV+1)&
105  &,  ZCLE0(KLON,KLEV), ZCLEAR(KLON) &
106  &,  ZR21(KLON)&
107  &,  ZR23(KLON) , ZSS0(KLON) , ZSCAT(KLON)&
108  &,  ZTR(KLON,2,KLEV+1)
109
110!     LOCAL INTEGER SCALARS
111INTEGER_M :: IKL, JA, JAE, JAJ, JK, JKL, JKLP1, JKM1, JL, INU1
112
113!     LOCAL REAL SCALARS
114REAL_B :: ZBMU0, ZBMU1, ZCORAE, ZDEN, ZDEN1, ZFACOA,&
115          &ZFF, ZGAP, ZGAR, ZMU1, ZMUE, ZRATIO, ZRE11, &
116          &ZTO, ZTRAY, ZWW
117
118
119!     ------------------------------------------------------------------
120
121!*         1.    OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
122!                --------------------------------------------
123
124
125DO JK = 1 , KLEV+1
126  DO JA = 1 , 6
127    DO JL = KIDIA,KFDIA
128      PRJ(JL,JA,JK) = _ZERO_
129      PRK(JL,JA,JK) = _ZERO_
130    ENDDO
131  ENDDO
132ENDDO
133
134! ------   NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
135
136DO JK = 1 , KLEV
137  IKL=KLEV+1-JK
138  DO JL = KIDIA,KFDIA
139    PCGAZ(JL,JK) = _ZERO_
140    PPIZAZ(JL,JK) =  _ZERO_
141    PTAUAZ(JL,JK) = _ZERO_
142  ENDDO
143  DO JAE=1,6
144    DO JL = KIDIA,KFDIA
145      PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE)
146      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)&
147       &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
148      PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL, JAE, IKL)&
149       &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
150    ENDDO
151  ENDDO
152
153  DO JL = KIDIA,KFDIA
154    IF (KAER /= 0) THEN
155      PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
156      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
157      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
158      ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
159      ZGAR = PCGAZ(JL,JK)
160      ZFF = ZGAR * ZGAR
161      PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)*(_ONE_-PPIZAZ(JL,JK)*ZFF)
162      PCGAZ(JL,JK) = ZGAR * (_ONE_ - ZRATIO) / (_ONE_ + ZGAR)
163      PPIZAZ(JL,JK) =ZRATIO+(_ONE_-ZRATIO)*PPIZAZ(JL,JK)*(_ONE_-ZFF)&
164       &/ (_ONE_ - PPIZAZ(JL,JK) * ZFF)
165    ELSE
166      ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
167      PTAUAZ(JL,JK) = ZTRAY
168      PCGAZ(JL,JK) = _ZERO_
169      PPIZAZ(JL,JK) = _ONE_-REPSCT
170    ENDIF
171  ENDDO
172ENDDO
173
174!     ------------------------------------------------------------------
175
176!*         2.    TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
177!                ----------------------------------------------
178
179
180DO JL = KIDIA,KFDIA
181  ZR23(JL) = _ZERO_
182  ZC0I(JL,KLEV+1) = _ZERO_
183  ZCLEAR(JL) = _ONE_
184  ZSCAT(JL) = _ZERO_
185ENDDO
186
187JK = 1
188JKL = KLEV+1 - JK
189JKLP1 = JKL + 1
190DO JL = KIDIA,KFDIA
191  ZFACOA = _ONE_ - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
192  ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
193  ZR21(JL) = EXP(-ZCORAE   )
194  ZSS0(JL) = _ONE_-ZR21(JL)
195  ZCLE0(JL,JKL) = ZSS0(JL)
196
197  IF (NOVLP == 1 .OR. NOVLP == 4) THEN
198!* maximum-random     
199    ZCLEAR(JL) = ZCLEAR(JL)&
200     &*(_ONE_-MAX(ZSS0(JL),ZSCAT(JL)))&
201     &/(_ONE_-MIN(ZSCAT(JL),_ONE_-REPCLC))
202    ZC0I(JL,JKL) = _ONE_ - ZCLEAR(JL)
203    ZSCAT(JL) = ZSS0(JL)
204  ELSEIF (NOVLP == 2) THEN
205!* maximum
206    ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
207    ZC0I(JL,JKL) = ZSCAT(JL)
208  ELSEIF (NOVLP == 3) THEN
209!* random
210    ZCLEAR(JL)=ZCLEAR(JL)*(_ONE_-ZSS0(JL))
211    ZSCAT(JL) = _ONE_ - ZCLEAR(JL)
212    ZC0I(JL,JKL) = ZSCAT(JL)
213  ENDIF
214ENDDO
215
216DO JK = 2 , KLEV
217  JKL = KLEV+1 - JK
218  JKLP1 = JKL + 1
219  DO JL = KIDIA,KFDIA
220    ZFACOA = _ONE_ - PPIZAZ(JL,JKL)*PCGAZ(JL,JKL)*PCGAZ(JL,JKL)
221    ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
222    ZR21(JL) = EXP(-ZCORAE   )
223    ZSS0(JL) = _ONE_-ZR21(JL)
224    ZCLE0(JL,JKL) = ZSS0(JL)
225
226    IF (NOVLP == 1 .OR. NOVLP == 4) THEN
227!* maximum-random     
228      ZCLEAR(JL) = ZCLEAR(JL)&
229       &*(_ONE_-MAX(ZSS0(JL),ZSCAT(JL)))&
230       &/(_ONE_-MIN(ZSCAT(JL),_ONE_-REPCLC))
231      ZC0I(JL,JKL) = _ONE_ - ZCLEAR(JL)
232      ZSCAT(JL) = ZSS0(JL)
233    ELSEIF (NOVLP == 2) THEN
234!* maximum
235      ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
236      ZC0I(JL,JKL) = ZSCAT(JL)
237    ELSEIF (NOVLP == 3) THEN
238!* random
239      ZCLEAR(JL)=ZCLEAR(JL)*(_ONE_-ZSS0(JL))
240      ZSCAT(JL) = _ONE_ - ZCLEAR(JL)
241      ZC0I(JL,JKL) = ZSCAT(JL)
242    ENDIF
243  ENDDO
244ENDDO
245
246!     ------------------------------------------------------------------
247
248!*         3.    REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
249!                -----------------------------------------------
250
251
252DO JL = KIDIA,KFDIA
253  PRAY1(JL,KLEV+1) = _ZERO_
254  PRAY2(JL,KLEV+1) = _ZERO_
255  PREFZ(JL,2,1) = PALBP(JL,KNU)
256  PREFZ(JL,1,1) = PALBP(JL,KNU)
257  PTRA1(JL,KLEV+1) = _ONE_
258  PTRA2(JL,KLEV+1) = _ONE_
259ENDDO
260
261DO JK = 2 , KLEV+1
262  JKM1 = JK-1
263  DO JL = KIDIA,KFDIA
264
265
266!     ------------------------------------------------------------------
267
268!*         3.1  EQUIVALENT ZENITH ANGLE
269!               -----------------------
270
271
272    ZMUE = (_ONE_-ZC0I(JL,JK)) * PSEC(JL)+ ZC0I(JL,JK) * 1.66_JPRB
273    PRMU0(JL,JK) = _ONE_/ZMUE
274
275
276!     ------------------------------------------------------------------
277
278!*         3.2  REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
279!               ----------------------------------------------------
280
281
282    ZGAP = PCGAZ(JL,JKM1)
283    ZBMU0 = _HALF_ - 0.75_JPRB * ZGAP / ZMUE
284    ZWW = PPIZAZ(JL,JKM1)
285    ZTO = PTAUAZ(JL,JKM1)
286    ZDEN = _ONE_ + (_ONE_ - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE &
287     &+ (1-ZWW) * (_ONE_ - ZWW +_TWO_*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
288    PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
289    PTRA1(JL,JKM1) = _ONE_ / ZDEN
290
291    ZMU1 = _HALF_
292    ZBMU1 = _HALF_ - 0.75_JPRB * ZGAP * ZMU1
293    ZDEN1= _ONE_ + (_ONE_ - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1 &
294     &+ (1-ZWW) * (_ONE_ - ZWW +_TWO_*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
295    PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
296    PTRA2(JL,JKM1) = _ONE_ / ZDEN1
297
298
299
300    PREFZ(JL,1,JK) = (PRAY1(JL,JKM1)&
301     &+ PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)&
302     &* PTRA2(JL,JKM1)&
303     &/ (_ONE_-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
304
305    ZTR(JL,1,JKM1) = (PTRA1(JL,JKM1)&
306     &/ (_ONE_-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
307
308    PREFZ(JL,2,JK) = (PRAY1(JL,JKM1)&
309     &+ PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)&
310     &* PTRA2(JL,JKM1) )
311
312    ZTR(JL,2,JKM1) = PTRA1(JL,JKM1)
313
314  ENDDO
315ENDDO
316DO JL = KIDIA,KFDIA
317  ZMUE = (_ONE_-ZC0I(JL,1))*PSEC(JL)+ZC0I(JL,1)*1.66_JPRB
318  PRMU0(JL,1)=_ONE_/ZMUE
319  PTRCLR(JL)=_ONE_-ZC0I(JL,1)
320ENDDO
321
322
323!     ------------------------------------------------------------------
324
325!*         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
326!                 -------------------------------------------------
327
328IF (NSW <= 4) THEN
329  INU1=1
330ELSE IF (NSW == 6) THEN
331  INU1=3
332END IF   
333
334IF (KNU <= INU1) THEN
335  JAJ = 2
336  DO JL = KIDIA,KFDIA
337    PRJ(JL,JAJ,KLEV+1) = _ONE_
338    PRK(JL,JAJ,KLEV+1) = PREFZ(JL, 1,KLEV+1)
339  ENDDO
340
341  DO JK = 1 , KLEV
342    JKL = KLEV+1 - JK
343    JKLP1 = JKL + 1
344    DO JL = KIDIA,KFDIA
345      ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
346      PRJ(JL,JAJ,JKL) = ZRE11
347      PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,  1,JKL)
348    ENDDO
349  ENDDO
350
351ELSE
352
353  DO JAJ = 1 , 2
354    DO JL = KIDIA,KFDIA
355      PRJ(JL,JAJ,KLEV+1) = _ONE_
356      PRK(JL,JAJ,KLEV+1) = PREFZ(JL,JAJ,KLEV+1)
357    ENDDO
358
359    DO JK = 1 , KLEV
360      JKL = KLEV+1 - JK
361      JKLP1 = JKL + 1
362      DO JL = KIDIA,KFDIA
363        ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
364        PRJ(JL,JAJ,JKL) = ZRE11
365        PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
366      ENDDO
367    ENDDO
368  ENDDO
369
370ENDIF
371
372!     ------------------------------------------------------------------
373
374RETURN
375END SUBROUTINE SWCLR
Note: See TracBrowser for help on using the repository browser.