/[lmdze]/trunk/libf/phylmd/Radlwsw/sw.f
ViewVC logotype

Annotation of /trunk/libf/phylmd/Radlwsw/sw.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 24 - (hide annotations)
Wed Mar 3 13:23:49 2010 UTC (14 years, 2 months ago) by guez
File size: 10688 byte(s)
Created directory "phylmd/Radlwsw". Split "radlwsw.f" in files
containing a single procedure.

Removed variable "itaufinp1" in "leapfrog".

1 guez 24 cIM ctes ds clesphys.h SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC,
2     SUBROUTINE SW(PSCT, PRMU0, PFRAC,
3     S PPMB, PDP,
4     S PPSOL, PALBD, PALBP,
5     S PTAVE, PWV, PQS, POZON, PAER,
6     S PCLDSW, PTAU, POMEGA, PCG,
7     S PHEAT, PHEAT0,
8     S PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,
9     S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,
10     S tauae, pizae, cgae,
11     s PTAUA, POMEGAA,
12     S PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI,
13     J ok_ade, ok_aie )
14    
15     use dimens_m
16     use dimphy
17     use clesphys
18     use YOMCST
19     use raddim
20     IMPLICIT none
21    
22     C
23     C ------------------------------------------------------------------
24     C
25     C PURPOSE.
26     C --------
27     C
28     C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
29     C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
30     C
31     C METHOD.
32     C -------
33     C
34     C 1. COMPUTES ABSORBER AMOUNTS (SWU)
35     C 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
36     C 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
37     C
38     C REFERENCE.
39     C ----------
40     C
41     C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
42     C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
43     C
44     C AUTHOR.
45     C -------
46     C JEAN-JACQUES MORCRETTE *ECMWF*
47     C
48     C MODIFICATIONS.
49     C --------------
50     C ORIGINAL : 89-07-14
51     C 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
52     c 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
53     C ------------------------------------------------------------------
54     C
55     C* ARGUMENTS:
56     C
57     REAL*8 PSCT ! constante solaire (valeur conseillee: 1370)
58     cIM ctes ds clesphys.h REAL*8 RCO2 ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)
59     C
60     REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (PA)
61     REAL*8 PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA)
62     REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
63     C
64     REAL*8 PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
65     REAL*8 PFRAC(KDLON) ! fraction de la journee
66     C
67     REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
68     REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
69     REAL*8 PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
70     REAL*8 POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG)
71     REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
72     C
73     REAL*8 PALBD(KDLON,2) ! albedo du sol (lumiere diffuse)
74     REAL*8 PALBP(KDLON,2) ! albedo du sol (lumiere parallele)
75     C
76     REAL*8 PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION
77     REAL*8 PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS
78     REAL*8 PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR
79     REAL*8 POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
80     C
81     REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
82     REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
83     REAL*8 PALBPLA(KDLON) ! PLANETARY ALBEDO
84     REAL*8 PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
85     REAL*8 PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
86     REAL*8 PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
87     REAL*8 PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
88     C
89     C* LOCAL VARIABLES:
90     C
91     REAL*8 ZOZ(KDLON,KFLEV)
92     REAL*8 ZAKI(KDLON,2)
93     REAL*8 ZCLD(KDLON,KFLEV)
94     REAL*8 ZCLEAR(KDLON)
95     REAL*8 ZDSIG(KDLON,KFLEV)
96     REAL*8 ZFACT(KDLON)
97     REAL*8 ZFD(KDLON,KFLEV+1)
98     REAL*8 ZFDOWN(KDLON,KFLEV+1)
99     REAL*8 ZFU(KDLON,KFLEV+1)
100     REAL*8 ZFUP(KDLON,KFLEV+1)
101     REAL*8 ZRMU(KDLON)
102     REAL*8 ZSEC(KDLON)
103     REAL*8 ZUD(KDLON,5,KFLEV+1)
104     REAL*8 ZCLDSW0(KDLON,KFLEV)
105     c
106     REAL*8 ZFSUP(KDLON,KFLEV+1)
107     REAL*8 ZFSDN(KDLON,KFLEV+1)
108     REAL*8 ZFSUP0(KDLON,KFLEV+1)
109     REAL*8 ZFSDN0(KDLON,KFLEV+1)
110     C
111     INTEGER inu, jl, jk, i, k, kpl1
112     c
113     INTEGER swpas ! Every swpas steps, sw is calculated
114     PARAMETER(swpas=1)
115     c
116     INTEGER itapsw
117     LOGICAL appel1er
118     DATA itapsw /0/
119     DATA appel1er /.TRUE./
120     cjq-Introduced for aerosol forcings
121     real*8 flag_aer
122     logical ok_ade, ok_aie ! use aerosol forcings or not?
123     real*8 tauae(kdlon,kflev,2) ! aerosol optical properties
124     real*8 pizae(kdlon,kflev,2) ! (see aeropt.F)
125     real*8 cgae(kdlon,kflev,2) ! -"-
126     REAL*8 PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
127     REAL*8 POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
128     REAL*8 PTOPSWAD(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
129     REAL*8 PSOLSWAD(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
130     REAL*8 PTOPSWAI(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
131     REAL*8 PSOLSWAI(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
132     cjq - Fluxes including aerosol effects
133     REAL*8 ZFSUPAD(KDLON,KFLEV+1)
134     REAL*8 ZFSDNAD(KDLON,KFLEV+1)
135     REAL*8 ZFSUPAI(KDLON,KFLEV+1)
136     REAL*8 ZFSDNAI(KDLON,KFLEV+1)
137     logical initialized
138     SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes
139     !rv
140     save flag_aer
141     data initialized/.false./
142     cjq-end
143     if(.not.initialized) then
144     flag_aer=0.
145     initialized=.TRUE.
146     endif
147     !rv
148    
149     c
150     IF (appel1er) THEN
151     PRINT*, 'SW calling frequency : ', swpas
152     PRINT*, " In general, it should be 1"
153     appel1er = .FALSE.
154     ENDIF
155     C ------------------------------------------------------------------
156     IF (MOD(itapsw,swpas).EQ.0) THEN
157     c
158     DO JK = 1 , KFLEV
159     DO JL = 1, KDLON
160     ZCLDSW0(JL,JK) = 0.0
161     IF (bug_ozone) then
162     ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG
163     . *PDP(JL,JK)*(101325.0/PPSOL(JL))
164     ELSE
165     c Correction MPL 100505
166     ZOZ(JL,JK) = POZON(JL,JK)*RMD/RMO3*46.6968/RG*PDP(JL,JK)
167     ENDIF
168     ENDDO
169     ENDDO
170     C
171     C
172     c clear-sky:
173     cIM ctes ds clesphys.h CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,
174     CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL,
175     S PRMU0,PFRAC,PTAVE,PWV,
176     S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
177     INU = 1
178     CALL SW1S(INU,
179     S PAER, flag_aer, tauae, pizae, cgae,
180     S PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
181     S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
182     S ZFD, ZFU)
183     INU = 2
184     CALL SW2S(INU,
185     S PAER, flag_aer, tauae, pizae, cgae,
186     S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
187     S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
188     S PWV, PQS,
189     S ZFDOWN, ZFUP)
190     DO JK = 1 , KFLEV+1
191     DO JL = 1, KDLON
192     ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
193     ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
194     ENDDO
195     ENDDO
196    
197     flag_aer=0.0
198     CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,
199     S PRMU0,PFRAC,PTAVE,PWV,
200     S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
201     INU = 1
202     CALL SW1S(INU,
203     S PAER, flag_aer, tauae, pizae, cgae,
204     S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
205     S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
206     S ZFD, ZFU)
207     INU = 2
208     CALL SW2S(INU,
209     S PAER, flag_aer, tauae, pizae, cgae,
210     S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
211     S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
212     S PWV, PQS,
213     S ZFDOWN, ZFUP)
214    
215     c cloudy-sky:
216    
217     DO JK = 1 , KFLEV+1
218     DO JL = 1, KDLON
219     ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
220     ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
221     ENDDO
222     ENDDO
223    
224     c
225     IF (ok_ade) THEN
226     c
227     c cloudy-sky + aerosol dir OB
228     flag_aer=1.0
229     CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,
230     S PRMU0,PFRAC,PTAVE,PWV,
231     S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
232     INU = 1
233     CALL SW1S(INU,
234     S PAER, flag_aer, tauae, pizae, cgae,
235     S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
236     S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
237     S ZFD, ZFU)
238     INU = 2
239     CALL SW2S(INU,
240     S PAER, flag_aer, tauae, pizae, cgae,
241     S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
242     S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
243     S PWV, PQS,
244     S ZFDOWN, ZFUP)
245     DO JK = 1 , KFLEV+1
246     DO JL = 1, KDLON
247     ZFSUPAD(JL,JK) = ZFSUP(JL,JK)
248     ZFSDNAD(JL,JK) = ZFSDN(JL,JK)
249     ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
250     ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
251     ENDDO
252     ENDDO
253    
254     ENDIF ! ok_ade
255    
256     IF (ok_aie) THEN
257    
258     cjq cloudy-sky + aerosol direct + aerosol indirect
259     flag_aer=1.0
260     CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,
261     S PRMU0,PFRAC,PTAVE,PWV,
262     S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
263     INU = 1
264     CALL SW1S(INU,
265     S PAER, flag_aer, tauae, pizae, cgae,
266     S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
267     S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,
268     S ZFD, ZFU)
269     INU = 2
270     CALL SW2S(INU,
271     S PAER, flag_aer, tauae, pizae, cgae,
272     S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
273     S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,
274     S PWV, PQS,
275     S ZFDOWN, ZFUP)
276     DO JK = 1 , KFLEV+1
277     DO JL = 1, KDLON
278     ZFSUPAI(JL,JK) = ZFSUP(JL,JK)
279     ZFSDNAI(JL,JK) = ZFSDN(JL,JK)
280     ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
281     ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
282     ENDDO
283     ENDDO
284     ENDIF ! ok_aie
285     cjq -end
286    
287     itapsw = 0
288     ENDIF
289     itapsw = itapsw + 1
290     C
291     DO k = 1, KFLEV
292     kpl1 = k+1
293     DO i = 1, KDLON
294     PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))
295     . -(ZFSDN(i,k)-ZFSDN(i,kpl1))
296     PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
297     PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))
298     . -(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
299     PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
300     ENDDO
301     ENDDO
302     DO i = 1, KDLON
303     PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
304     c
305     PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
306     PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
307     c
308     PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
309     PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
310     c-OB
311     PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1)
312     PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1)
313     c
314     PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1)
315     PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1)
316     c-fin
317     ENDDO
318     C
319     RETURN
320     END

  ViewVC Help
Powered by ViewVC 1.1.21