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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 82 - (hide annotations)
Wed Mar 5 14:57:53 2014 UTC (10 years, 2 months ago) by guez
File size: 10960 byte(s)
Changed all ".f90" suffixes to ".f".
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 guez 72 ! Purpose.
14     ! This routine computes the shortwave radiation fluxes in two
15     ! spectral intervals following Fouquart and Bonnel (1980).
16 guez 53
17 guez 72 ! 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 guez 53
22 guez 72 ! Reference.
23     ! See radiation part of the ECMWF research department
24     ! documentation, and Fouquart and Bonnel (1980)
25 guez 53
26 guez 72 ! Author.
27     ! Jean-Jacques Morcrette *ecmwf*
28 guez 53
29 guez 72 ! 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 guez 53
34     USE clesphys, ONLY: bug_ozone
35 guez 72 USE raddim, ONLY: kdlon, kflev
36 guez 70 USE suphec_m, ONLY: rcpd, rday, rg, md, rmo3
37 guez 53
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 guez 72 INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
96 guez 53
97 guez 72 INTEGER:: itapsw = 0
98     LOGICAL:: appel1er = .TRUE.
99 guez 53 !jq-Introduced for aerosol forcings
100 guez 72 double precision, save:: flag_aer
101 guez 62 logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
102 guez 53 double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
103     double precision pizae(kdlon, kflev, 2)
104     ! aerosol optical properties(see aeropt.F)
105    
106     double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
107     DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
108     ! CLOUD OPTICAL THICKNESS (pre-industrial value)
109    
110     DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
111     DOUBLE PRECISION PTOPSWAD(KDLON)
112     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
113    
114     DOUBLE PRECISION PSOLSWAD(KDLON)
115     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
116    
117     DOUBLE PRECISION PTOPSWAI(KDLON)
118     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
119    
120     DOUBLE PRECISION PSOLSWAI(KDLON)
121     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
122    
123     !jq - Fluxes including aerosol effects
124 guez 72 DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
125     DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
126     DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
127     DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
128 guez 53
129 guez 72 logical:: initialized = .false.
130    
131 guez 53 !-------------------------------------------------------------------
132    
133     if(.not.initialized) then
134     flag_aer=0.
135     initialized=.TRUE.
136 guez 72 ZFSUPAD = 0.
137     ZFSDNAD = 0.
138     ZFSUPAI = 0.
139     ZFSDNAI = 0.
140 guez 53 endif
141     !rv
142    
143     IF (appel1er) THEN
144     PRINT*, 'SW calling frequency: ', swpas
145     PRINT*, " In general, it should be 1"
146     appel1er = .FALSE.
147     ENDIF
148    
149     IF (MOD(itapsw, swpas).EQ.0) THEN
150     DO JK = 1 , KFLEV
151     DO JL = 1, KDLON
152     ZCLDSW0(JL, JK) = 0.0
153     IF (bug_ozone) then
154     ZOZ(JL, JK) = POZON(JL, JK)*46.6968/RG &
155     *PDP(JL, JK)*(101325.0/PPSOL(JL))
156     ELSE
157     ! Correction MPL 100505
158 guez 70 ZOZ(JL, JK) = POZON(JL, JK)*MD/RMO3*46.6968/RG*PDP(JL, JK)
159 guez 53 ENDIF
160     ENDDO
161     ENDDO
162    
163     ! clear-sky:
164     CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
165     PRMU0, PFRAC, PTAVE, PWV, &
166     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
167     INU = 1
168     CALL SW1S(INU, &
169     PAER, flag_aer, tauae, pizae, cgae, &
170     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
171     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
172     ZFD, ZFU)
173     INU = 2
174     CALL SW2S(INU, &
175     PAER, flag_aer, tauae, pizae, cgae, &
176     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
177     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
178     PWV, PQS, &
179     ZFDOWN, ZFUP)
180     DO JK = 1 , KFLEV+1
181     DO JL = 1, KDLON
182     ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
183     ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
184     ENDDO
185     ENDDO
186    
187 guez 62 flag_aer=0.
188 guez 53 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
189     PRMU0, PFRAC, PTAVE, PWV, &
190     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
191     INU = 1
192     CALL SW1S(INU, &
193     PAER, flag_aer, tauae, pizae, cgae, &
194     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
195     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
196     ZFD, ZFU)
197     INU = 2
198     CALL SW2S(INU, &
199     PAER, flag_aer, tauae, pizae, cgae, &
200     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
201     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
202     PWV, PQS, &
203     ZFDOWN, ZFUP)
204    
205     ! cloudy-sky:
206    
207     DO JK = 1 , KFLEV+1
208     DO JL = 1, KDLON
209     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
210     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
211     ENDDO
212     ENDDO
213    
214     IF (ok_ade) THEN
215     ! cloudy-sky + aerosol dir OB
216 guez 62 flag_aer=1.
217 guez 53 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
218     PRMU0, PFRAC, PTAVE, PWV, &
219     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
220     INU = 1
221     CALL SW1S(INU, &
222     PAER, flag_aer, tauae, pizae, cgae, &
223     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
224     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
225     ZFD, ZFU)
226     INU = 2
227     CALL SW2S(INU, &
228     PAER, flag_aer, tauae, pizae, cgae, &
229     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
230     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
231     PWV, PQS, &
232     ZFDOWN, ZFUP)
233     DO JK = 1 , KFLEV+1
234     DO JL = 1, KDLON
235     ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
236     ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
237     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
238     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
239     ENDDO
240     ENDDO
241     ENDIF
242    
243     IF (ok_aie) THEN
244     !jq cloudy-sky + aerosol direct + aerosol indirect
245     flag_aer=1.0
246     CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
247     PRMU0, PFRAC, PTAVE, PWV, &
248     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
249     INU = 1
250     CALL SW1S(INU, &
251     PAER, flag_aer, tauae, pizae, cgae, &
252     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
253     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
254     ZFD, ZFU)
255     INU = 2
256     CALL SW2S(INU, &
257     PAER, flag_aer, tauae, pizae, cgae, &
258     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
259     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
260     PWV, PQS, &
261     ZFDOWN, ZFUP)
262     DO JK = 1 , KFLEV+1
263     DO JL = 1, KDLON
264     ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
265     ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
266     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
267     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
268     ENDDO
269     ENDDO
270     ENDIF
271    
272     itapsw = 0
273     ENDIF
274     itapsw = itapsw + 1
275    
276     DO k = 1, KFLEV
277     kpl1 = k+1
278     DO i = 1, KDLON
279     PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
280     -(ZFSDN(i, k)-ZFSDN(i, kpl1))
281     PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
282     PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
283     -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
284     PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
285     ENDDO
286     ENDDO
287     DO i = 1, KDLON
288     PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
289    
290     PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
291     PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
292    
293     PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
294     PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
295    
296     PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
297     PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
298    
299     PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
300     PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
301     ENDDO
302    
303     END SUBROUTINE SW
304    
305     end module sw_m

  ViewVC Help
Powered by ViewVC 1.1.21