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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 118 - (show annotations)
Thu Dec 18 17:30:24 2014 UTC (9 years, 4 months ago) by guez
File size: 10768 byte(s) 
In file grilles_gcm.nc, renamed variable phis to orog, deleted
variable presnivs.

Removed variable bug_ozone from module clesphys.

In procedure ozonecm, moved computation of sint and cost out of the
loops on horizontal position and vertical level. Inverted the order of
the two loops. We can then move all computations from slat to aprim
out of the loop on vertical levels. Created variable slat2, following
LMDZ. Moved the limitation of column-density of ozone in cell at 1e-12
from radlwsw to ozonecm, following LMDZ.

Removed unused arguments u, albsol, rh, cldfra, rneb, diafra, cldliq,
pmflxr, pmflxs, prfl, psfl of phytrac.

In procedure yamada4, for all the arrays, replaced the dimension klon
by ngrid. At the end of the procedure, for the computation of kmn,kn,
kq and q2, changed the upper limit of the loop index from klon to ngrid.

In radlwsw, for the calculation of pozon, removed the factor
paprs(iof+i, 1)/101325, as in LMDZ. In procedure sw, removed the
factor 101325.0/PPSOL(JL), as in LMDZ.
1 module sw_m
2
3 IMPLICIT none
4
5 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 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 raddim, ONLY: kdlon, kflev
35 USE suphec_m, ONLY: rcpd, rday, rg
36
37 ! ARGUMENTS:
38
39 DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
40
41 DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
42 DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
43 DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
44
45 DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
46 DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
47
48 DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
49 DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
50 DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
51 DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
52 DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! AEROSOLS' OPTICAL THICKNESS
53
54 DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
55 DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
56
57 DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
58 DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
59 DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
60 DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
61
62 DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
63 DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
64 DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
65 DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
66 DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
67 DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
68 DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
69
70 ! LOCAL VARIABLES:
71
72 DOUBLE PRECISION ZOZ(KDLON, KFLEV)
73 DOUBLE PRECISION ZAKI(KDLON, 2)
74 DOUBLE PRECISION ZCLD(KDLON, KFLEV)
75 DOUBLE PRECISION ZCLEAR(KDLON)
76 DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
77 DOUBLE PRECISION ZFACT(KDLON)
78 DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
79 DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
80 DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
81 DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
82 DOUBLE PRECISION ZRMU(KDLON)
83 DOUBLE PRECISION ZSEC(KDLON)
84 DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
85 DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
86
87 DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
88 DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
89 DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
90 DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
91
92 INTEGER inu, jl, jk, i, k, kpl1
93
94 INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
95
96 INTEGER:: itapsw = 0
97 LOGICAL:: appel1er = .TRUE.
98 !jq-Introduced for aerosol forcings
99 double precision, save:: flag_aer
100 logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
101 double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
102 double precision pizae(kdlon, kflev, 2)
103 ! aerosol optical properties(see aeropt.F)
104
105 double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
106 DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
107 ! CLOUD OPTICAL THICKNESS (pre-industrial value)
108
109 DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
110 DOUBLE PRECISION PTOPSWAD(KDLON)
111 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
112
113 DOUBLE PRECISION PSOLSWAD(KDLON)
114 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
115
116 DOUBLE PRECISION PTOPSWAI(KDLON)
117 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
118
119 DOUBLE PRECISION PSOLSWAI(KDLON)
120 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
121
122 !jq - Fluxes including aerosol effects
123 DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
124 DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
125 DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
126 DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
127
128 logical:: initialized = .false.
129 REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
130
131 !-------------------------------------------------------------------
132
133 if(.not.initialized) then
134 flag_aer=0.
135 initialized=.TRUE.
136 ZFSUPAD = 0.
137 ZFSDNAD = 0.
138 ZFSUPAI = 0.
139 ZFSDNAI = 0.
140 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 ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
154 ENDDO
155 ENDDO
156
157 ! clear-sky:
158 CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
159 PRMU0, PFRAC, PTAVE, PWV, &
160 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
161 INU = 1
162 CALL SW1S(INU, &
163 PAER, flag_aer, tauae, pizae, cgae, &
164 PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
165 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
166 ZFD, ZFU)
167 INU = 2
168 CALL SW2S(INU, &
169 PAER, flag_aer, tauae, pizae, cgae, &
170 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
171 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
172 PWV, PQS, &
173 ZFDOWN, ZFUP)
174 DO JK = 1 , KFLEV+1
175 DO JL = 1, KDLON
176 ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
177 ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
178 ENDDO
179 ENDDO
180
181 flag_aer=0.
182 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
183 PRMU0, PFRAC, PTAVE, PWV, &
184 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
185 INU = 1
186 CALL SW1S(INU, &
187 PAER, flag_aer, tauae, pizae, cgae, &
188 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
189 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
190 ZFD, ZFU)
191 INU = 2
192 CALL SW2S(INU, &
193 PAER, flag_aer, tauae, pizae, cgae, &
194 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
195 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
196 PWV, PQS, &
197 ZFDOWN, ZFUP)
198
199 ! cloudy-sky:
200
201 DO JK = 1 , KFLEV+1
202 DO JL = 1, KDLON
203 ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
204 ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
205 ENDDO
206 ENDDO
207
208 IF (ok_ade) THEN
209 ! cloudy-sky + aerosol dir OB
210 flag_aer=1.
211 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
212 PRMU0, PFRAC, PTAVE, PWV, &
213 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
214 INU = 1
215 CALL SW1S(INU, &
216 PAER, flag_aer, tauae, pizae, cgae, &
217 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
218 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
219 ZFD, ZFU)
220 INU = 2
221 CALL SW2S(INU, &
222 PAER, flag_aer, tauae, pizae, cgae, &
223 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
224 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
225 PWV, PQS, &
226 ZFDOWN, ZFUP)
227 DO JK = 1 , KFLEV+1
228 DO JL = 1, KDLON
229 ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
230 ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
231 ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
232 ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
233 ENDDO
234 ENDDO
235 ENDIF
236
237 IF (ok_aie) THEN
238 !jq cloudy-sky + aerosol direct + aerosol indirect
239 flag_aer=1.0
240 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
241 PRMU0, PFRAC, PTAVE, PWV, &
242 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
243 INU = 1
244 CALL SW1S(INU, &
245 PAER, flag_aer, tauae, pizae, cgae, &
246 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
247 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
248 ZFD, ZFU)
249 INU = 2
250 CALL SW2S(INU, &
251 PAER, flag_aer, tauae, pizae, cgae, &
252 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
253 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
254 PWV, PQS, &
255 ZFDOWN, ZFUP)
256 DO JK = 1 , KFLEV+1
257 DO JL = 1, KDLON
258 ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
259 ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
260 ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
261 ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
262 ENDDO
263 ENDDO
264 ENDIF
265
266 itapsw = 0
267 ENDIF
268 itapsw = itapsw + 1
269
270 DO k = 1, KFLEV
271 kpl1 = k+1
272 DO i = 1, KDLON
273 PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
274 -(ZFSDN(i, k)-ZFSDN(i, kpl1))
275 PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
276 PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
277 -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
278 PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
279 ENDDO
280 ENDDO
281 DO i = 1, KDLON
282 PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
283
284 PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
285 PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
286
287 PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
288 PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
289
290 PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
291 PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
292
293 PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
294 PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
295 ENDDO
296
297 END SUBROUTINE SW
298
299 end module sw_m
  ViewVC Help
Powered by ViewVC 1.1.21