BUGSrad
 All Classes Files Functions Variables
bugs_lwr.f
Go to the documentation of this file.
1 
2 
3 ! CVS: $Id: bugs_lwr.F,v 1.7 2006/11/16 18:45:09 norm Exp $
4 ! CVS: $Name: $
5 ! Modified for new version of planck function
6 
7 !-----------------------------------------------------------------------
8 
9  subroutine bugs_lwr
10  + ( ncol , nlm , pp , ppl
11  +, dp , tt , rmix , cwrho
12  +, cirho , o3mix , ts , cldamt
13  +, cldmax , b1 , b2 , b3
14  +, b4 , umco2 , umch4 , umn2o
15  +, fdlw , fdlwcl , fulw , fulwcl
16  +, sel_rules
17  + )
18 
19  use kinds
20  use bugsrad_planck, only: planck
21  use gases_ckd, only: gases, stanpir,pscale
22  use continuum
23  implicit none
24 
25 !-----------------------------------------------------------------------
26 ! REFERENCES:
27 ! bugs_lwr replaces crclwr written by G. Stephens. bugs_lwr computes the
28 ! downward and upward longwave radiative fluxes, and longwave heating
29 ! rates.
30 ! Laura D. Fowler (slikrock/08-23-96).
31 
32 ! send comments to laura@slikrock.atmos.colostate.edu and
33 ! partain@atmos.colostate.edu.
34 
35 ! MODIFICATIONS:
36 ! * moved the computation of the all-sky and clear-sky radiative heating
37 ! rates to bugs_rad.
38 ! Laura D. Fowler and Phil Partain/slikrock (01-27-99).
39 
40 ! * added effective radii of cloud droplets and ice crystals that are
41 ! dependent on the cloud water and cloud ice contents.
42 ! Laura D. Fowler/slikrock (06-08-00).
43 
44 ! * cleaned up the argument list to remove variables related to short
45 ! wave radiative transfer.
46 ! Laura D. Fowler/slikrock (02-01-00).
47 
48 ! * changed declarations to adapt the code from BUGS4 to BUGS5.
49 ! Laura D. Fowler/slikrock (02-01-00).
50 
51 ! SUBROUTINES CALLED:
52 
53 ! pscale : pressure scaling.
54 ! cloudg : computes cloud optical properties of water/ice
55 ! clouds.
56 ! gascon_ckd_parm : water vapor continuum absorption.
57 ! plank : computes planck function.
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_lw : 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  &, cldmax!Maximum cloud fraction (-).
93 
94  real (kind=dbl_kind), intent(in), dimension(ncol,nlm)::
95  & ppl!Layer pressure (hPa).
96  &, dp !Layer thickness (hPa).
97  &, tt !Temperature (K).
98  &, rmix !Water vapor mixing ratio (kg/kg).
99  &, cwrho !Cloud water mixing ratio (g/m^3).
100  &, cirho !Cloud ice mixing ratio (g/m^3).
101  &, o3mix !Ozone mixing ratio (kg/kg).
102  &, cldamt!Cloud fraction (-).
103  &, b1 !Cloud overlap parameter (-).
104  &, b2 !Cloud overlap parameter (-).
105  &, b3 !Cloud overlap parameter (-).
106  &, b4 !Cloud overlap parameter (-).
107 
108  real (kind=dbl_kind), intent(in), dimension(ncol,nlm+1)::
109  & pp !Level pressure (hPa).
110 
111 
112 ! OUTPUT ARGUMENTS:
113 ! -----------------
114  real (kind=dbl_kind), intent(out), dimension(ncol,nlm+1)::
115  & fdlw !Downward LW flux (W/m^2).
116  &, fdlwcl!Downward clear-ksy LW flux (W/m^2).
117  &, fulw !Upward LW flux (W/m^2).
118  &, fulwcl!Upward clear-sky LW flux (W/m^2).
119 
120 ! LOCAL VARIABLES:
121 
122  integer (kind=int_kind)::
123  & mb !Total number of spectral intervals.
124  &, mbs !Number of shortwave (SW) spectral intervals.
125  &, mbir !Number of shortwave (LW) spectral intervals.
126  parameter(mb=18,mbs=6,mbir=12)
127 
128  integer (kind=int_kind)::
129  & i !Horizontal index.
130  &, l !Vertical index.
131  &, ib !Index of spectral interval.
132  &, ig !Index of k-distribution.
133  &, ibmbs !Index of LW spectral interval.
134 
135  integer (kind=int_kind), dimension(ncol,nlm)::
136  & ip1 !Used in conjunction with pressure weigthing.
137  &, ip2 !Used in conjunction with pressure weigthing.
138 
139  real (kind=dbl_kind)::
140  & hk !Weighted spectral solar constant (W/m^2). .
141  &, tmax !Temperature threshold (K). .
142  &, eps !Threshold for cloud optical properties .
143  &, pdist
144  data eps,tmax,pdist /1.e-05,340.,2./
145 
146  real (kind=dbl_kind), dimension(mbir)::
147  & kg !Nb of k-distributions per spectral intervals.
148  data kg /2,3,4,4,3,5,2,10,12,7,7,8/
149 
150  real (kind=dbl_kind), dimension(mbir)::
151  & asym_wat !Spectral asymmetry factor of water clouds.
152  &, asym_ice !Spectral asymmetry factor of ice clouds.
153 
154  real (kind=dbl_kind), dimension(mb)::
155  & cnrw !Real part of refractive index (Water clouds).
156  &, cniw !Imaginary part of refractive index (Water clouds).
157  &, cnri !Real part of refractive index (Ice clouds).
158  &, cnii !Imaginary part of refractive indec (Ice clouds).
159  &, xlam !Center of spectral band.
160 
161  real (kind=dbl_kind), dimension(ncol,mbir)::
162  & es !Spectral surface emissivity (-).
163 
164  real (kind=dbl_kind), dimension(ncol,nlm)::
165  & rew !Effective radius for cloud water (mu).
166  &, rei !Effective radius for cloud ice (mu).
167  &, ttem !Local temperature (K).
168  &, pkd !
169  &, tau1 !All-sky optical depth (-).
170  &, tauclr1 !Clear-sky optical depth (-).
171  &, tau !All-sky optical depth (-).
172  &, tauclr !Clear-sky optical depth (-).
173  &, taer !Aerosol optical depth (-).
174  &, tray !Rayley optical depth (-).
175  &, tg !Gases optical depth (-).
176  &, tgm !WV continuum optical depth (-).
177  &, tcldi !Ice cloud optical depth (-).
178  &, tcldw !Water cloud optical depth (-).
179  &, wc !All-sky single scattering albedo (-).
180  &, wcclr !Clear-sky single scattering albedo (-).
181  &, waer !Aerosol single scattering albedo (-).
182  &, wray !Rayley single scattering albedo (-).
183  &, wcldi !Ice cloud single scattering albedo (-).
184  &, wcldw !Water cloud single scattering albedo (-).
185  &, asym !All-sky asymmetry factor (-).
186  &, asyclr !Clear-sky asymmetry factor (-).
187  &, asyaer !Aerosol asymmetry factor (-).
188  &, asycldi !Ice cloud asymmetry factor (-).
189  &, asycldw !Water cloud asymmetry factor (-).
190  &, fwclr !
191  &, fwcld !
192 
193  real (kind=dbl_kind), dimension(ncol,nlm+1)::
194  & bf !Planck function for layers (W/m^2).
195  &, fdg !Spectral downward flux (W/m^2).
196  &, fdgcl !Spectral clear-sky downward flux (W/m^2).
197  &, fug !Spectral upward flux (W/m^2).
198  &, fugcl !Spectral clear-sky upward flux (W/m^2).
199 
200 ! longwave asymmetry parameters:
201 ! (assumes: re=10 for water; re=30 for ice)
202  data asym_wat /0.8200, 0.8547, 0.8619, 0.8683, 0.8723, 0.8703
203  +, 0.8566, 0.8040, 0.7463, 0.6579, 0.5103, 0.1279 /
204  data asym_ice /0.8524, 0.8791, 0.9022, 0.8797, 0.8637, 0.8722
205  +, 0.8609, 0.8168, 0.7663, 0.6584, 0.6172, 0.3585 /
206 
207 !--- cnrw and cniw (water clouds):
208  data cnrw/1.3422,1.3281,1.3174,1.2901,1.3348,1.3700,1.3191,1.2821
209  &, 1.3160,1.3030,1.2739,1.2319,1.1526,1.1981,1.3542,1.4917
210  &, 1.5463,1.8718/
211  data cniw/6.4790e-9,1.3417e-06,1.2521e-4,7.1533e-4,4.2669e-2
212  &, 4.3785e-3,1.3239e-2 ,1.5536e-2,5.3894e-2,3.4346e-2
213  &, 3.7490e-2,4.7442e-2 ,1.2059e-1,3.3546e-1,4.1698e-1
214  &, 4.0674e-1,3.6362e-1 ,5.2930e-1/
215 
216 !--- cnri and cnii (ice clouds):
217  data cnri/1.3266,1.2986,1.2826,1.2556,1.2963,1.3956
218  &, 1.3324,1.2960,1.3121,1.3126,1.2903,1.2295
219  &, 1.1803,1.5224,1.5572,1.5198,1.4993,1.7026/
220  data cnii/7.0696e-9,9.1220e-7,1.2189e-4,5.7648e-4,4.3144e-2
221  &, 8.2935e-3,1.5540e-2,2.5594e-2,5.9424e-2,5.1511e-2
222  &, 4.0325e-2,4.7994e-2,2.3834e-1,3.0697e-1,1.1852e-1
223  &, 4.3048e-2,6.3218e-2,1.5843e-1/
224 
225 !---- spectral band center:
226  data xlam/0.45 ,1.0 ,1.6 ,2.2 ,3.0 ,3.75 ,4.878 ,5.556
227  &, 6.452 ,7.547 ,8.511,9.615,11.236,13.605,16.529,21.277
228  &, 29.412,71.403/
229 
230 !-----------------------------------------------------------------------
231 
232 !---- 0. initialize output arrays:
233 
234  fdlw(:,:) = 0.
235  fdlwcl(:,:) = 0.
236  fulw(:,:) = 0.
237  fulwcl(:,:) = 0.
238 
239  rew(:,:) = 10.
240  rei(:,:) = 30.
241 
242  do l = 1, nlm
243  do i = 1, ncol
244  ttem(i,l) = min(tmax,tt(i,l))
245  enddo
246  enddo
247 
248 !---- note: this will be changed to accomodate the spectral dependence
249 ! the surface emissivity:
250 
251  do ib = 1, mbir
252  do i = 1, ncol
253  es(i,ib) = 1.
254  enddo
255  enddo
256 
257 !-- pressure scaling:
258 
259  call pscale(ncol,nlm,ppl,stanpir,pkd,ip1,ip2)
260 
261 !---- 1. loop over the mbir spectral intervals starts here:
262 
263  do ib = mbs+1, mb
264  ibmbs = ib - mbs
265 
266  tray(:,:) = 0.
267  wray(:,:) = 0.
268  taer(:,:) = 0.
269  waer(:,:) = 0.
270  asyaer(:,:) = 1.
271 
272 !---- 1.1 optical properties of water and ice clouds (as in crclwr for
273 ! now):
274 
275  call cloudg
276  + ( ncol , nlm , mb , ib
277  +, pp , tt , cwrho , rew
278  +, pdist , cnrw , cniw , cnri
279  +, cnii , xlam , tcldw , wcldw
280  +, asycldw , .false.
281  + )
282 
283  call cloudg
284  + ( ncol , nlm , mb , ib
285  +, pp , tt , cirho , rei
286  +, pdist , cnrw , cniw , cnri
287  +, cnii , xlam , tcldi , wcldi
288  +, asycldi , .true.
289  + )
290 
291 ! the asymmetry factor for water and ice clouds are fixed as for now
292 ! functions of the spectral intervals:
293 
294  do l = 1, nlm
295  do i = 1, ncol
296  if(cwrho(i,l) .ge. eps) asycldw(i,l) = asym_wat(ibmbs)
297  if(cirho(i,l) .ge. eps) asycldi(i,l) = asym_ice(ibmbs)
298  enddo
299  enddo
300 
301 !---- 1.2 water vapor continuum:
302 
303  call gascon
304  + (ncol , nlm, ib , pp
305  +, ppl , dp, tt , rmix
306  +, tgm
307  + )
308 
309 !---- 1.3 planck function:
310  call planck(ncol,nlm,ibmbs,ts,tt,bf)
311 
312 !---- 1.4 combines single-scattering properties for gray absorption:
313 
314  call comscp1
315  + ( ncol , nlm , taer , tcldi
316  +, tcldw , tgm , tray , waer
317  +, wcldi , wcldw , wray , asyaer
318  +, asycldi , asycldw , tau1 , tauclr1
319  +, asym , asyclr , fwcld , fwclr
320  + )
321 
322 !---- loop over the k-probability distributions starts here:
323 
324  do ig = 1, kg(ibmbs)
325 
326 !---- 1.5 gaseous absorption:
327 
328  call gases
329  + ( ncol , nlm , ib , ig
330  +, pp , dp , tt , rmix
331  +, o3mix , umco2 , umch4 , umn2o
332  +, hk , tg , pkd , ip1
333  +, ip2
334  + )
335 
336 !---- 1.6 combines all single-scattering properties:
337 
338  call comscp2
339  + ( ncol , nlm , tg , fwcld
340  +, fwclr , tau1 , tauclr1 , tau
341  +, tauclr , wc , wcclr
342  + )
343 
344 
345  !NBW - Minor (?) bug fix
346  !With near-zero CO2 and very low water vapor amounts, the
347  !correlated-K parameterization can generate negative optical
348  !depths in the CO2-H2O overlap bands. Here's a quick fix:
349  where (tau .lt. 0)
350  tau = 0.
351  endwhere
352  where (tauclr .lt. 0)
353  tauclr = 0.
354  endwhere
355 
356 !---- 1.7 two-stream approximation:
357 ! No overlap
358  call two_rt_lw
359  + ( ncol , nlm , mbs , mbir
360  +, ib , wc , asym , tau
361  +, es , bf , fug , fdg
362  +, sel_rules
363  + )
364 
365  call two_rt_lw
366  + ( ncol , nlm , mbs , mbir
367  +, ib , wcclr , asyclr , tauclr
368  +, es , bf , fugcl , fdgcl
369  +, sel_rules
370  + )
371  fdlw(:,:) = fdlw(:,:) + fdg(:,:)*hk
372  fulw(:,:) = fulw(:,:) + fug(:,:)*hk
373  fdlwcl(:,:) = fdlwcl(:,:) + fdgcl(:,:)*hk
374  fulwcl(:,:) = fulwcl(:,:) + fugcl(:,:)*hk
375 
376  enddo ! end k-distribution
377 
378  enddo ! end spectral interval
379 
380 
381  return
382  end subroutine bugs_lwr
383 
384 c-----------------------------------------------------------------------
Generated on Tue Aug 13 2013 10:38:25 for BUGSrad by   doxygen 1.8.3.1