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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 53 - (hide annotations)
Fri Oct 7 13:11:58 2011 UTC (12 years, 7 months ago) by guez
Original Path: trunk/libf/phylmd/Radlwsw/sw.f90
File size: 10972 byte(s)


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

  ViewVC Help
Powered by ViewVC 1.1.21