BUGSrad
 All Classes Files Functions Variables
bugs_swr.f
Go to the documentation of this file.
1 
2 
3 ! CVS: $Id: bugs_swr.F,v 1.4 2005/11/22 21:55:48 norm Exp $
4 ! CVS: $Name: $
5 
6 !-----------------------------------------------------------------------
7 
8  subroutine bugs_swr
9  + ( ncol , nlm , pp , ppl
10  +, dp , tt , rmix , cwrho
11  +, cirho , o3mix , ts , amu0
12  +, slr , alvdf , alndf , alvdr
13  +, alndr , cldamt , cldmax , umco2
14  +, umch4 , umn2o , b1 , b2
15  +, b3 , b4 , fdsw , fdswcl
16  +, fusw , fuswcl , radvbc , radvbccl
17  +, radvdc ,radvdccl , radnbc , radnbccl
18  +, radndc ,radndccl ,sel_rules
19  + )
20 
21 
22  use kinds
23  use gases_ckd, only: gases, stanps, pscale
24  use rayleigh, only: rayle
25  implicit none
26 
27 !-----------------------------------------------------------------------
28 ! REFERENCES:
29 ! bugs_swr replaces crcswr written by G. Stephens. BUGSswr computes the
30 ! downward and upward SW radiative fluxes, and SW heating rates.
31 ! Laura D. Fowler (slikrock/08-20-97).
32 
33 ! send comments to laura@slikrock.atmos.colostate.edu and
34 ! partain@atmos.colostate.edu.
35 
36 ! MODIFICATIONS:
37 ! * moved the computation of the all-sky and clear-sky radiative heating
38 ! rates to bugs_rad.
39 ! Laura D. Fowler and Phil Partain(slikrock/01-27-99).
40 
41 ! * added effective radii of cloud droplets and ice crystals that are
42 ! dependent on the cloud water and cloud ice contents.
43 ! Laura D. Fowler/slikrock (06-08-00).
44 
45 ! * cleaned up the argument list to remove variables related to short
46 ! wave radiative transfer.
47 ! Laura D. Fowler/slikrock (02-01-00).
48 
49 ! * changed declarations to adapt the code from BUGS4 to BUGS5.
50 ! Laura D. Fowler/slikrock (02-01-00).
51 
52 ! SUBROUTINES CALLED:
53 
54 ! pscale : pressure scaling.
55 ! cloudg : computes cloud optical properties of water/ice
56 ! clouds.
57 ! rayle : Computes Rayleigh scattering properties.
58 ! comscp1 : combines optical properties for gray absorption
59 ! (clouds and water vapor continuum).
60 ! comscp2 : combines optical properties for non-gray gaseous
61 ! absorption.
62 ! gases : computes gases absorption.
63 ! two_rt_sw : two-stream parameterization.
64 
65 ! FUNCTIONS CALLED:
66 ! none.
67 
68 ! INCLUDED COMMONS:
69 ! none.
70 
71 ! ARGUMENT LIST VARIABLES:
72 ! All arrays indexed as nlm correspond to variables defined in the
73 ! middle of layers. All arrays indexed as nlm+1 correspond to variables
74 ! defined at levels at the top and bottom of layers.
75 
76 ! INPUT ARGUMENTS:
77 ! ----------------
78  logical (kind=log_kind), intent(in)::
79  & sel_rules
80 
81  integer (kind=int_kind), intent(in)::
82  & ncol !Length of sub-domain.
83  &, nlm !Number of layers.
84 
85  real (kind=dbl_kind), intent(in)::
86  & umco2 !Concentration of CO2 (ppm).
87  &, umch4 !Concentration of CH4 (???).
88  &, umn2o !Concentration of N2o (???).
89 
90  real (kind=dbl_kind), intent(in), dimension(ncol)::
91  & ts!Surface temperature (K).
92  &, amu0 !Cosine of solar zenith angle (-).
93  &, slr !Fraction of daylight (-).
94  &, alvdr !Visible direct surface albedo (-).
95  &, alndr !Near-IR direct surface albedo (-).
96  &, alvdf !Visible diffuse surface albedo (-).
97  &, alndf !Near-IR diffuse surface albedo (-).
98  &, cldmax !Maximum cloud fraction (-).
99 
100  real (kind=dbl_kind), intent(in), dimension(ncol,nlm)::
101  & ppl !Layer pressure (hPa).
102  &, dp !Layer thickness (hPa).
103  &, tt !Temperature (K).
104  &, rmix !Water vapor mixing ratio (kg/kg).
105  &, cwrho !Cloud water water content (g/m^-3).
106  &, cirho !Cloud ice content (g/m^-3).
107  &, o3mix !Ozone mixing ratio (kg/kg).
108  &, cldamt !Cloud fraction (-).
109  &, b1 !Cloud overlap parameter (-).
110  &, b2 !Cloud overlap parameter (-).
111  &, b3 !Cloud overlap parameter (-).
112  &, b4 !Cloud overlap parameter (-).
113 
114  real (kind=dbl_kind), intent(in), dimension(ncol,nlm+1)::
115  & pp !Level pressure (hPa).
116 
117 
118 
119 ! OUTPUT ARGUMENTS:
120 ! -----------------
121  real (kind=dbl_kind), intent(out), dimension(ncol)::
122  & radvbc !SFC all-sky visible direct net SW radiation (W/m^-2).
123  &, radvbccl!SFC clear-sky visible direct net SW radiation (W/m^-2).
124  &, radvdc !SFC all-sky visible direct net SW radiation (W/m^-2).
125  &, radvdccl!SFC clear-sky visible direct net SW radiation (W/m^-2).
126  &, radnbc !SFC all-sky near-ir direct net SW radiation (W/m^-2).
127  &, radnbccl!SFC clear-sky near-ir direct net SW radiation (W/m^-2).
128  &, radndc !SFC all-sky near-ir direct net SW radiation (W/m^-2).
129  &, radndccl!SFC clear-sky near-ir direct net SW radiation (W/m^-2).
130 
131  real (kind=dbl_kind), intent(out), dimension(ncol,nlm+1)::
132  & fdsw !Downward SW flux (W/m^-2).
133  &, fdswcl !Downward clear-ksy SW flux (W/m^-2).
134  &, fusw !Upward SW flux (W/m^-2).
135  &, fuswcl !Upward clear-sky SW flux (W/m^-2).
136 
137 ! LOCAL VARIABLES:
138 
139  integer (kind=int_kind)::
140  & mb !Total number of spectral intervals.
141  &, mbs !Number of shortwave (SW) spectral intervals.
142  &, mbir !Number of shortwave (LW) spectral intervals.
143  parameter(mb=18,mbs=6,mbir=12)
144 
145  integer (kind=int_kind) ::
146  & i !Horizontal index.
147  &, l !Vertical index.
148  &, ib !Index of spectral interval.
149  &, ig !Index of k-distribution.
150 
151  integer (kind=int_kind), dimension(ncol,nlm)::
152  & ip1 !Used in conjunction with pressure weigthing.
153  &, ip2 !Used in conjunction with pressure weigthing.
154 
155  real(kind=dbl_kind)
156  & hk !Weighted spectral solar constant (W/m^-2). .
157  &, tmax !Temperature threshold (K).
158  &, eps !Threshold for cloud optical properties .
159  &, pdist
160  data eps,tmax,pdist /1.e-05,340.,2./
161 
162  real (kind=dbl_kind), dimension(mbs)::
163  & kg !Nb of k-distributions per spectral intervals.
164  data kg /10,8,12,7,12,5/
165 
166  real (kind=dbl_kind), dimension(mbs)::
167  & asym_wat!Spectral asymmetry factor of water clouds.
168  &, asym_ice!Spectral asymmetry factor of ice clouds.
169  &, ri !Coefficients related to Rayleigh absorption.
170  data ri / 0.9022e-5, 0.5282e-6, 0.5722e-7
171  &, 0.1433e-7, 0.4526e-8, 0.1529e-8 /
172 
173  real (kind=dbl_kind), dimension(mb)::
174  & cnrw !Real part of refractive index (Water clouds).
175  &, cniw !Imaginary part of refractive index (Water clouds).
176  &, cnri !Real part of refractive index (Ice clouds).
177  &, cnii !Imaginary part of refractive indec (Ice clouds).
178  &, xlam !Center of spectral band.
179 
180  real (kind=dbl_kind), dimension(ncol,mbs)::
181  & asdir !Spectral direct surface albedo (-).
182  &, asdif !Spectral diffuse surface albedo (-).
183 
184  real (kind=dbl_kind), dimension(ncol,nlm)::
185  & rew !Effective radius for cloud water (mu).
186  &, rei !Effective radius for cloud ice (mu).
187  &, ttem !Local temperature (K).
188  &, pkd !
189  &, tau1 !All-sky optical depth (-).
190  &, tauclr1 !Clear-sky optical depth (-).
191  &, tau !All-sky optical depth (-).
192  &, tauclr !Clear-sky optical depth (-).
193  &, taer !Aerosol optical depth (-).
194  &, tray !Rayley optical depth (-).
195  &, tg !Gases optical depth (-).
196  &, tgm !WV continuum optical depth (-).
197  &, tcldi !Ice cloud optical depth (-).
198  &, tcldw !Water cloud optical depth (-).
199  &, wc !All-sky single scattering albedo (-).
200  &, wcclr !Clear-sky single scattering albedo (-).
201  &, waer !Aerosol single scattering albedo (-).
202  &, wray !Rayley single scattering albedo (-).
203  &, wcldi !Ice cloud single scattering albedo (-).
204  &, wcldw !Water cloud single scattering albedo (-).
205  &, asym !All-sky asymmetry factor (-).
206  &, asyclr !Clear-sky asymmetry factor (-).
207  &, asyaer !Aerosol asymmetry factor (-).
208  &, asycldi !Ice cloud asymmetry factor (-).
209  &, asycldw !Water cloud asymmetry factor (-).
210  &, fwclr !
211  &, fwcld !
212 
213  real (kind=dbl_kind), dimension(ncol,nlm+1)::
214  & fdgdir!Spectral direct downward flux (W/m^2).
215  &, fdgcldir!Spectral direct clear-sky downward flux (W/m^2).
216  &, fdgdif!Spectral diffuse downward flux (W/m^2).
217  &, fdgcldif!Spectral diffuse clear-sky downward flux (W/m^2).
218  &, fugdif!Spectral diffuse upward flux (W/m^2).
219  &, fugcldif!Spectral diffuse clear-sky upward flux (W/m^2).
220 
221 ! shortwave asymmetry parameters:
222 ! (assumes: re=10 for water; re=30 for ice)
223  data asym_wat / 0.8625, 0.8469, 0.8287, 0.8182, 0.9472, 0.7630 /
224  data asym_ice / 0.8678, 0.8640, 0.8653, 0.8615, 0.9526, 0.8293 /
225 
226 !--- cnrw and cniw (water clouds):
227  data cnrw/1.3422,1.3281,1.3174,1.2901,1.3348,1.3700,1.3191,1.2821
228  &, 1.3160,1.3030,1.2739,1.2319,1.1526,1.1981,1.3542,1.4917
229  &, 1.5463,1.8718/
230  data cniw/6.4790e-9,1.3417e-06,1.2521e-4,7.1533e-4,4.2669e-2
231  &, 4.3785e-3,1.3239e-2 ,1.5536e-2,5.3894e-2,3.4346e-2
232  &, 3.7490e-2,4.7442e-2 ,1.2059e-1,3.3546e-1,4.1698e-1
233  &, 4.0674e-1,3.6362e-1 ,5.2930e-1/
234 
235 !--- cnri and cnii (ice clouds):
236  data cnri/1.3266,1.2986,1.2826,1.2556,1.2963,1.3956
237  &, 1.3324,1.2960,1.3121,1.3126,1.2903,1.2295
238  &, 1.1803,1.5224,1.5572,1.5198,1.4993,1.7026/
239  data cnii/7.0696e-9,9.1220e-7,1.2189e-4,5.7648e-4,4.3144e-2
240  &, 8.2935e-3,1.5540e-2,2.5594e-2,5.9424e-2,5.1511e-2
241  &, 4.0325e-2,4.7994e-2,2.3834e-1,3.0697e-1,1.1852e-1
242  &, 4.3048e-2,6.3218e-2,1.5843e-1/
243 
244 !---- spectral band center:
245  data xlam/0.45 ,1.0 ,1.6 ,2.2 ,3.0 ,3.75 ,4.878 ,5.556
246  &, 6.452 ,7.547 ,8.511,9.615,11.236,13.605,16.529,21.277
247  &, 29.412,71.403/
248 
249 !-----------------------------------------------------------------------
250 
251 !---- 0. initialize local and output arrays:
252 
253  radvbc(:) = 0.
254  radvbccl(:) = 0.
255  radvdc(:) = 0.
256  radvdccl(:) = 0.
257  radnbc(:) = 0.
258  radnbccl(:) = 0.
259  radndc(:) = 0.
260  radndccl(:) = 0.
261 
262  fdsw(:,:) = 0.
263  fdswcl(:,:) = 0.
264  fusw(:,:) = 0.
265  fuswcl(:,:) = 0.
266 
267  rew(:,:) = 10.
268  rei(:,:) = 30.
269 
270  fdgdir(:,:) = 0.0
271  fdgcldir(:,:) = 0.0
272  fdgdif(:,:) = 0.0
273  fdgcldif(:,:) = 0.0
274  fugdif(:,:) = 0.0
275  fugcldif(:,:) = 0.0
276 
277  do l = 1, nlm
278  do i = 1, ncol
279  ttem(i,l) = min(tmax,tt(i,l))
280  enddo
281  enddo
282 
283  do i = 1, ncol
284  asdir(i,1) = alvdr(i)
285  asdir(i,2:6) = alndr(i)
286  asdif(i,1) = alvdf(i)
287  asdif(i,2:6) = alndf(i)
288  enddo
289 
290 !-- pressure scaling:
291 
292  call pscale(ncol,nlm,ppl,stanps,pkd,ip1,ip2)
293 
294 !---- 1. loop over the mbs spectral intervals starts here:
295 
296  do ib = 1, mbs
297 
298  tgm(:,:) = 0.
299  taer(:,:) = 0.
300  waer(:,:) = 0.
301  asyaer(:,:) = 1.
302 ! fdswband(:,:) = 0.
303 ! fuswband(:,:) = 0.
304 
305 !---- 1.1 rayleigh absorption:
306 
307  call rayle(
308  + nlm,
309  + ib,
310  + pp,
311  + tray,
312  + wray)
313 
314 !---- 1.2 optical properties of water and ice clouds (as in crcswr for
315 ! now):
316 
317  call cloudg
318  + ( ncol , nlm , mb , ib
319  +, pp , tt , cwrho , rew
320  +, pdist , cnrw , cniw , cnri
321  +, cnii , xlam , tcldw , wcldw
322  +, asycldw , .false.
323  + )
324 
325  call cloudg
326  + ( ncol , nlm , mb , ib
327  +, pp , tt , cirho , rei
328  +, pdist , cnrw , cniw , cnri
329  +, cnii , xlam , tcldi , wcldi
330  +, asycldi , .true.
331  + )
332 
333 ! the asymmetry factor for water and ice clouds are fixed as
334 ! functions of the spectral intervals.
335 
336  do l = 1, nlm
337  do i = 1, ncol
338  if(cwrho(i,l).ge.eps) asycldw(i,l) = asym_wat(ib)
339  if(cirho(i,l).ge.eps) asycldi(i,l) = asym_ice(ib)
340  enddo
341  enddo
342 
343 !---- 1.3 combines single-scattering properties for gray absorption:
344 
345  call comscp1
346  + ( ncol , nlm , taer , tcldi
347  +, tcldw , tgm , tray , waer
348  +, wcldi , wcldw , wray , asyaer
349  +, asycldi , asycldw , tau1 , tauclr1
350  +, asym , asyclr , fwcld , fwclr
351  + )
352 
353 !---- loop over the k-probability distributions starts here:
354 
355  do ig = 1, kg(ib)
356 
357 !---- 1.4 non-gray gaseous absorption:
358 
359  call gases
360  + ( ncol , nlm , ib , ig
361  +, pp , dp , ttem , rmix
362  +, o3mix , umco2 , umch4 , umn2o
363  +, hk , tg , pkd , ip1
364  +, ip2
365  + )
366 
367 !---- 1.5 combines single-scattering properties:
368 
369  call comscp2
370  + ( ncol , nlm , tg , fwcld
371  +, fwclr , tau1 , tauclr1 , tau
372  +, tauclr , wc , wcclr
373  + )
374 
375 !---- 1.6 two-stream approximation:
376 ! No overlap
377  call two_rt_sw
378  + ( ncol , nlm , mbs , ib
379  +, slr , amu0 , wc , asym
380  +, tau , asdir , asdif , fugdif
381  +, fdgdir , fdgdif , sel_rules
382  + )
383 
384  call two_rt_sw
385  + ( ncol , nlm , mbs , ib
386  +, slr , amu0 , wcclr , asyclr
387  +, tauclr , asdir , asdif , fugcldif
388  +, fdgcldir ,fdgcldif , sel_rules
389  + )
390 
391  fdsw(:,:) = fdsw(:,:)
392  + + (fdgdir(:,:)+fdgdif(:,:))*hk
393  fusw(:,:) = fusw(:,:) + fugdif(:,:)*hk
394  fdswcl(:,:) = fdswcl(:,:)
395  + + (fdgcldir(:,:)+fdgcldif(:,:)) * hk
396  fuswcl(:,:) = fuswcl(:,:) + fugcldif(:,:)*hk
397 
398 !---- 1.7 computes the surface visible and near infrared net radiation.
399  select case (ib)
400 
401  case(1)
402  radvbc(:) = radvbc(:) + fdgdir(:,nlm+1)*hk
403  radvbccl(:) = radvbccl(:) + fdgcldir(:,nlm+1)*hk
404  radvdc(:) = radvdc(:) + fdgdif(:,nlm+1)*hk
405  radvdccl(:) = radvdccl(:) + fdgcldif(:,nlm+1)*hk
406 
407  case(2:6)
408  radnbc(:) = radnbc(:) + fdgdir(:,nlm+1)*hk
409  radnbccl(:) = radnbccl(:) + fdgcldir(:,nlm+1)*hk
410  radndc(:) = radndc(:) + fdgdif(:,nlm+1)*hk
411  radndccl(:) = radndccl(:) + fdgcldif(:,nlm+1)*hk
412 
413  end select
414 
415  enddo ! end k-distribution
416  enddo ! end spectral interval
417 
418  return
419  end subroutine bugs_swr
420 
421 !-----------------------------------------------------------------------
422 
Generated on Tue Aug 13 2013 10:38:25 for BUGSrad by   doxygen 1.8.3.1