BUGSrad
 All Classes Files Functions Variables
bugs_rad.f
Go to the documentation of this file.
1 
2 
3 ! CVS: $Id: bugs_rad.F,v 1.7 2003/11/12 20:37:49 norm Exp $
4 ! CVS: $Name: $
5 
6 !------------------------------------------------------------------------
7 
8  subroutine bugs_rad
9  + ( nlen , len , nlm , pl2
10  +, pl , dpl , tl , ql
11  +, qcwl , qcil , qril , o3l
12  +, ts , amu0 , slr , alvdf
13  +, alndf , alvdr , alndr , s0
14  +, grav , cp , asl , atl
15  +, fdsw , fusw , fdlw , fulw
16  +, acld, umco2, umch4, umn2o )
17 
18  use kinds
19 
20 
21  implicit none
22 
23 !------------------------------------------------------------------------
24 ! bugs_rad is the driver for the parameterization of the cloud fraction,
25 ! cloud optical properties, and long and short wave radiative fluxes.
26 
27 ! REFERENCES:
28 ! Laura D. Fowler, and Phil Partain /slikrock (01-11-98).
29 
30 ! MODIFICATIONS:
31 ! * added 1 compiler directive; Phil Partain (04-04-00).
32 
33 ! * changed declarations to adapt the code from BUGS4 to BUGS5.
34 ! Laura D. Fowler/slikrock (02-01-00).
35 
36 ! SUBROUTINES CALLED:
37 ! EAUcf :Calculation of the cloud fraction.
38 ! EAUcfQPs :Calculation of diagnostics related to EAUcf.
39 ! BUGSlwr :Calculation of LW radiative heating rates and fluxes.
40 ! BUGSswr :Calculation of SW radiative heating rates and fluxes.
41 ! BUGSradQPs:Calculation of diagnostics related to BUGSlwr and
42 ! BUGSswr.
43 ! note: EAUcf, EAUcfQPs, and BUGSradQPs are not called in the offline
44 ! version of this code.
45 
46 ! FUNCTIONS CALLED:
47 ! none.
48 
49 ! INCLUDED COMMON BLOCKS:
50 ! none.
51 
52 ! ARGUMENT LIST VARIABLES:
53 ! INPUT ARGUMENTS:
54 ! ----------------
55  integer (kind=int_kind), intent(in)::
56  & nlen !Length of total domain.
57  &, len !Length of sub domain.
58  &, nlm !Number of layers.
59 
60  real (kind=dbl_kind), intent(in)::
61  & grav !Gravitational constant
62  &, cp !Constant pressure spec. heat of dry air (J/(K-kg)).
63  &, s0 !Solar constant (W/m^-2).
64 
65  real (kind=dbl_kind), intent(in), dimension(nlen)::
66  & ts !Surface temperature (K).
67  &, amu0 !Cosine of solar zenith angle (-).
68  &, slr !Fraction of daylight (-).
69  &, alvdr !Visible direct surface albedo (-).
70  &, alndr !Near-IR direct surface albedo (-).
71  &, alvdf !Visible diffuse surface albedo (-).
72  &, alndf !Near-IR diffuse surface albedo (-).
73 
74  real (kind=dbl_kind), intent(in), dimension(nlen,nlm)::
75  & pl !Layer pressure (hPa).
76  &, dpl !Layer thickness (hPa).
77  &, tl !Temperature (K).
78  &, ql !Specific humidity (kg/kg).
79  &, qcwl !Cloud water mixing ratio (kg/kg).
80  &, qcil !Cloud ice mixing ratio (kg/kg).
81  &, qril !Snow mixing ratio (kg/kg).
82  &, o3l !Ozone mixing ratio (kg/kg).
83  real (kind=dbl_kind), intent(in), dimension(nlen,nlm+1)::
84  & pl2 !Level pressure (hPa).
85 
86  real (kind=dbl_kind), intent(in), dimension(nlen,nlm)::
87  & acld !Radiative cloud fraction (-).
88  real (kind=dbl_kind), intent(in), dimension(nlen) ::
89  & umco2 !Concentration of CO2 (ppm).
90  &, umch4 !Concentration of CH4 (ppm).
91  &, umn2o !Concentration of N2O (ppm).
92 
93 
94 
95 ! OUTPUT ARGUMENTS:
96 ! ------------------
97  real (kind=dbl_kind), dimension(nlen)::
98  & radvbc !SFC visible direct net SW radiation (W/m^-2).
99  &, radvdc !SFC visible diffuse net SW radiation (W/m^-2).
100  &, radnbc !SFC near-ir direct net SW radiation (W/m^-2).
101  &, radndc !SFC near-ir diffuse net SW radiation (W/m^-2).
102  &, radvbcc !SFC visible direct clear net SW radiation (W/m^-2).
103  &, radvdcc !SFC visible diffuse clear net SW radiation (W/m^-2).
104  &, radnbcc !SFC near-ir direct clear net SW radiation (W/m^-2).
105  &, radndcc !SFC near-ir diffuse clear net SW radiation (W/m^-2).
106 
107  real (kind=dbl_kind), dimension(len,nlm+1)::
108  & fdsw !Downward SW flux (W/m^-2).
109  &, fusw !Upward SW flux (W/m^-2).
110  &, fdlw !Downward LW flux (W/m^-2).
111  &, fulw !Upward LW flux (W/m^-2).
112  &, fdswcl !Downward clear-sky SW flux (W/m^-2).
113  &, fuswcl !Upward clear-sky SW flux (W/m^-2).
114  &, fdlwcl !Downward clear-sky LW flux (W/m^-2).
115  &, fulwcl !Upward clear-sky LW flux (W/m^-2).
116  real (kind=dbl_kind), dimension(nlen,nlm)::
117  & atl !All-sky LW radiative heating rate (K/s).
118  &, asl !All-sky SW radiative heating rate (K/s).
119  &, atlcl !Clear-sky LW radiative heating rate (K/s).
120  &, aslcl !Clear-sky SW radiative heating rate (K/s).
121 
122 ! LOCAL VARIABLES:
123 
124  character(len=80), save::
125  & cvs_version1
126  &, cvs_version2
127 
128  logical (kind=log_kind)::
129  & sel_rules_lw
130  &, sel_rules_sw
131 
132  logical (kind=log_kind), dimension(len)::
133  & bitx !Scans daytime grid-points (-).
134 
135  integer (kind=int_kind)::
136  & i, l, ll
137  &, nnp !Number of layers plus one (TOA "sponge" layer).
138  &, nday !Number of daytime grid-points .
139 
140  integer (kind=int_kind), dimension(len)::
141  & iday !Location of daytime grid-points.
142 
143  real (kind=dbl_kind)::
144  & heat_fac !Mutiplying factor .
145 
146  real (kind=dbl_kind), dimension(len)::
147  & ts_loc !Local surface temperature (K).
148  &, amu0_loc !Local cosine of solar zenith angle (-).
149  &, slr_loc !Local fraction of daylight (-).
150  &, alvdr_loc !Local visible direct surface albedo (-).
151  &, alndr_loc !Local near-IR direct surface albedo (-).
152  &, alvdf_loc !Local visible diffuse surface albedo (-).
153  &, alndf_loc !Local near-IR diffuse surface albedo (-).
154  &, acldmx !Local Maximum cloud fraction (-).
155  &, den !Multiplying factor .
156  &, delf !Net flux
157  &, delfcl !Net flux (clear)
158  &, radvbc_loc !Local SFC visible direct net SW radiation (W/m^-2).
159  &, radvdc_loc !Local SFC visible direct net SW radiation (W/m^-2).
160  &, radnbc_loc !Local SFC near-ir direct net SW radiation (W/m^-2).
161  &, radndc_loc !Local SFC near-ir direct net SW radiation (W/m^-2).
162  &, radvbcc_loc!As radvbc_loc, but clear-sky (W/m^-2).
163  &, radvdcc_loc!As radvbc_loc, but clear-sky (W/m^-2).
164  &, radnbcc_loc!As radncb_loc, but clear-sky (W/m^-2).
165  &, radndcc_loc!As radncb_loc, but clear-sky (W/m^-2).
166 
167  real (kind=dbl_kind), dimension(len,nlm)::
168  & pl_loc !Local layer pressure (hPa).
169  &, dpl_loc !Local layer thickness (hPa).
170  &, tl_loc !Local temperature (K).
171  &, ql_loc !Local specific humidity (kg/kg).
172  &, qcwl_loc !Local cloud water mixing ratio (kg/kg).
173  &, qcil_loc !Local cloud ice mixing ratio (kg/kg).
174  &, o3l_loc !Local ozone mixing ratio (kg/kg).
175  &, acld_loc !Local radiative cloud fraction (-).
176  &, rmix !Water vapor mixing ratio (kg/kg).
177  &, cwrho !Density of cloud water (g/m^-3).
178  &, cirho !Density of cloud ice (g/m^-3).
179  &, o3mix !Ozone mixing ratio (kg/kg).
180  &, b1 !Cloud overlap parameter (-).
181  &, b2 !Cloud overlap parameter (-).
182  &, b3 !Cloud overlap parameter (-).
183  &, b4 !Cloud overlap parameter (-).
184 
185  real (kind=dbl_kind), dimension(len,nlm+1)::
186  & pl2_loc !Local level pressure (hPa).
187 
188  real (kind=dbl_kind), dimension(:), allocatable::
189  & ts_day !As ts_loc, but for daytime grid-points (K).
190  &, amu0_day !As amu0_loc,but for daytime grid-points (-).
191  &, slr_day !As slr_loc,but for daytime grid-points (-).
192  &, alvdf_day !As alvdf_loc,but for daytime grid-points (-).
193  &, alndf_day !As alndf_loc,but for daytime grid-points (-).
194  &, alvdr_day !As alvdr_loc,but for daytime grid-points (-).
195  &, alndr_day !As alndr_loc,but for daytime grid-points (-).
196  &, acldmx_day !As acldmx_loc,but for daytime grid-points (-).
197 
198  real (kind=dbl_kind), dimension(:,:), allocatable::
199  & pl_day !As pl,but for daytime grid-points (hPa).
200  &, dpl_day !As dpl,but for daytime grid-points (hPa).
201  &, tl_day !As tl,but for daytime grid-points (K).
202  &, rmix_day !As rmix,but for daytime grid-points (kg/kg).
203  &, cwrho_day !As cwrho,but for daytime grid-points (g/m^-3).
204  &, cirho_day !As cirho,but for daytime grid-points (g/m^-3).
205  &, o3mix_day !As o3mix,but for daytime grid-points (kg/kg).
206  &, acld_day !As acld,but for daytime grid-points (-).
207 
208  real (kind=dbl_kind), dimension(:,:), allocatable::
209  & pl2_day !As pl2_loc, but for daytime grid-points (hPa).
210  &, fdsw_day !As fdsw, but for daytime grid points (W/m^-2).
211  &, fdswcl_day !As fdswcl, but for daytime grid points (W/m^-2).
212  &, fusw_day !As fusw, but for daytime grid points (W/m^-2).
213  &, fuswcl_day !As fuswcl, but for daytime grid points (W/m^-2).
214  &, b1_day !As b1, but for daytime grid points (-).
215  &, b2_day !As b2, but for daytime grid points (-).
216  &, b3_day !As b3, but for daytime grid points (-).
217  &, b4_day !As b4, but for daytime grid points (-).
218 
219  real (kind=dbl_kind), dimension(:), allocatable::
220  & radvbc_day !As radvbc_loc, but for daytime grid-points (W/m^-2).
221  &, radvdc_day !As radvbc_loc, but for daytime grid-points (W/m^-2).
222  &, radnbc_day !As radnbc_loc, but for daytime grid-points (W/m^-2).
223  &, radndc_day !As radnbc_loc, but for daytime grid-points (W/m^-2).
224  &, radvbcc_day!As radvbcc, but for daytime grid-points (W/m^-2).
225  &, radvdcc_day!As radvbcc, but for daytime grid-points (W/m^-2).
226  &, radnbcc_day!As radnbc_loc, but for daytime grid-points (W/m^-2).
227  &, radndcc_day!As radnbc_loc, but for daytime grid-points (W/m^-2).
228 
229 
230 
231 !-----------------------------------------------------------------------
232 ! print*,'---- enter subroutine bugs_rad:'
233 
234 !---- 1.0 initialization of output variables and arrays:
235 
236  acld_loc(:,:) = 0.
237  fdsw(:,:) = 0.
238  fdswcl(:,:) = 0.
239  fusw(:,:) = 0.
240  fuswcl(:,:) = 0.
241  fdlw(:,:) = 0.
242  fdlwcl(:,:) = 0.
243  fulw(:,:) = 0.
244  fulwcl(:,:) = 0.
245  atlcl(1:len,:) = 0.
246  aslcl(1:len,:) = 0.
247  atl(1:len,:) = 0.
248  asl(1:len,:) = 0.
249  radvbc(1:len) = 0.
250  radvdc(1:len) = 0.
251  radnbc(1:len) = 0.
252  radndc(1:len) = 0.
253  radvbcc(1:len) = 0.
254  radvdcc(1:len) = 0.
255  radnbcc(1:len) = 0.
256  radndcc(1:len) = 0.
257  radvbc_loc(1:len) = 0.
258  radvdc_loc(1:len) = 0.
259  radnbc_loc(1:len) = 0.
260  radndc_loc(1:len) = 0.
261  radvbcc_loc(1:len) = 0.
262  radvdcc_loc(1:len) = 0.
263  radnbcc_loc(1:len) = 0.
264  radndcc_loc(1:len) = 0.
265 
266 
267 !---- 1.1 initialization of local scalars
268 
269  cvs_version1 =
270  & "Version:$Id: bugs_rad.F,v 1.7 2003/11/12 20:37:49 norm Exp $"
271  cvs_version2 =
272  & "Version:$Name: $"
273 
274  sel_rules_sw = .false.
275  sel_rules_lw = .false.
276 
277  heat_fac = grav*0.01/cp
278 
279 !---- 1.2 initialization of local arrays
280 
281  ts_loc(:) = ts(1:len)
282  amu0_loc(:) = amu0(1:len)
283  slr_loc(:) = slr(1:len)
284  alvdr_loc(:) = alvdr(1:len)
285  alndr_loc(:) = alndr(1:len)
286  alvdf_loc(:) = alvdf(1:len)
287  alndf_loc(:) = alndf(1:len)
288 
289  nnp = nlm
290  pl2_loc(:,:) = pl2(:,:)
291  pl_loc(:,:) = pl(:,:)
292  dpl_loc(:,:) = dpl(:,:)
293  tl_loc(:,:) = tl(:,:)
294  ql_loc(:,:) = ql(:,:)
295  qcwl_loc(:,:)= qcwl(:,:)
296  qcil_loc(:,:)= qcil(:,:)
297  o3l_loc(:,:) = o3l(:,:)
298  acld_loc(:,:)= acld(1:len,1:nlm)
299 
300  do l = 1, nlm
301  acldmx(1:len) = max(acldmx(1:len),acld_loc(1:len,l))
302  enddo
303 
304 
305 
306 !--- 2. computation of cloud overlap parameters
307  do i = 1, len
308  b1(i,1) = 1.0 - acld_loc(i,1)
309  b3(i,1) = 1.0
310  do l = 2,nlm
311  if (acld_loc(i,l-1).eq.1.0) then
312  b1(i,l) = 1.0
313  else
314  b1(i,l) = (1.0 - max(acld_loc(i,l),acld_loc(i,l-1))) /
315  * (1.0 - acld_loc(i,l-1))
316  endif
317  if (acld_loc(i,l-1).eq.0.0) then
318  b3(i,l) = 1.0
319  else
320  b3(i,l) = min(acld_loc(i,l),acld_loc(i,l-1)) /
321  & acld_loc(i,l-1)
322  endif
323  enddo
324 
325  b2(i,nlm) = 1.0 - acld_loc(i,nlm)
326  b4(i,nlm) = 1.0
327  do l = 1,nlm-1
328  if (acld_loc(i,l+1).eq.1.0) then
329  b2(i,l) = 1.0
330  else
331  b2(i,l) = (1.0 - max(acld_loc(i,l),acld_loc(i,l+1))) /
332  * (1.0 - acld_loc(i,l+1))
333  endif
334  if (acld_loc(i,l+1).eq.0.0) then
335  b4(i,l) = 1.0
336  else
337  b4(i,l) = min(acld_loc(i,l),acld_loc(i,l+1)) /
338  & acld_loc(i,l+1)
339  endif
340  enddo
341  enddo
342 ! do l = 1,nlm
343 ! print *,l,acld_loc(1,l),b1(1,l),b2(1,l),b3(1,l),b4(1,l)
344 ! enddo
345 
346 
347  do l = 1, nnp
348  den(1:len) = pl_loc(1:len,l)*100/(287.*tl_loc(1:len,l))
349  rmix(1:len,l) = ql_loc(1:len,l)/(1.-ql_loc(1:len,l))
350  cwrho(1:len,l) = den*1000.*qcwl_loc(1:len,l)*acld_loc(1:len,l)
351  cirho(1:len,l) = den*1000.*qcil_loc(1:len,l)*acld_loc(1:len,l)
352  o3mix(1:len,l) = o3l_loc(1:len,l)
353  enddo
354 
355 
356 
357 !-- 3. call to the bugs_rad longwave radiation code:
358 ! print*,'---- enter subroutine bugs_lwr:'
359  call bugs_lwr
360  + ( len , nnp , pl2_loc , pl_loc
361  +, dpl_loc , tl_loc , rmix , cwrho
362  +, cirho , o3mix , ts_loc ,acld_loc
363  +, acldmx , b1 , b2 , b3
364  +, b4 , umco2 , umch4 , umn2o
365  +, fdlw , fdlwcl , fulw , fulwcl
366  +, sel_rules_lw
367  + )
368 
369 ! print*,'---- exit subroutine bugs_lwr:'
370 
371 !-- 4. call to the bugs_rad shortwave radiation code:
372 
373 !-- note: slr needs to be modified to accomodate the difference in
374 ! s0 between the original radiation code and that in BUGS2.
375  slr_loc(1:len) = slr_loc(1:len) * s0/1339.945
376 
377 !-- note: computation of the shortwave radiative heating rates and
378 ! fluxes are made for daytime grid-points only:
379  bitx(1:len) = amu0_loc(1:len) .ge. 0.01
380  nday = 0
381  do i = 1, len
382  if(bitx(i)) then
383  nday = nday + 1
384  iday(nday) = i
385  endif
386  enddo
387  if(nday .eq. 0) goto 1000
388 
389  allocate(ts_day(nday))
390  allocate(amu0_day(nday))
391  allocate(slr_day(nday))
392  allocate(alvdr_day(nday))
393  allocate(alndr_day(nday))
394  allocate(alvdf_day(nday))
395  allocate(alndf_day(nday))
396  allocate(acldmx_day(nday))
397  allocate(pl_day(nday,nnp))
398  allocate(dpl_day(nday,nnp))
399  allocate(tl_day(nday,nnp))
400  allocate(rmix_day(nday,nnp))
401  allocate(cwrho_day(nday,nnp))
402  allocate(cirho_day(nday,nnp))
403  allocate(o3mix_day(nday,nnp))
404  allocate(acld_day(nday,nnp))
405  allocate(b1_day(nday,nnp))
406  allocate(b2_day(nday,nnp))
407  allocate(b3_day(nday,nnp))
408  allocate(b4_day(nday,nnp))
409 
410  allocate(pl2_day(nday,nnp+1))
411 
412  allocate(fdsw_day(nday,nnp+1))
413  allocate(fdswcl_day(nday,nnp+1))
414  allocate(fusw_day(nday,nnp+1))
415  allocate(fuswcl_day(nday,nnp+1))
416  allocate(radvbc_day(nday))
417  allocate(radvdc_day(nday))
418  allocate(radnbc_day(nday))
419  allocate(radndc_day(nday))
420  allocate(radvbcc_day(nday))
421  allocate(radvdcc_day(nday))
422  allocate(radnbcc_day(nday))
423  allocate(radndcc_day(nday))
424 
425  ts_day(1:nday) = ts_loc(iday(1:nday))
426  amu0_day(1:nday) = amu0_loc(iday(1:nday))
427  slr_day(1:nday) = slr_loc(iday(1:nday))
428  alvdf_day(1:nday) = alvdf_loc(iday(1:nday))
429  alndf_day(1:nday) = alndf_loc(iday(1:nday))
430  alvdr_day(1:nday) = alvdr_loc(iday(1:nday))
431  alndr_day(1:nday) = alndr_loc(iday(1:nday))
432  acldmx_day(1:nday) = acldmx(iday(1:nday))
433  pl_day(1:nday,1:nnp) = pl_loc(iday(1:nday),1:nnp)
434  dpl_day(1:nday,1:nnp) = dpl_loc(iday(1:nday),1:nnp)
435  tl_day(1:nday,1:nnp) = tl_loc(iday(1:nday),1:nnp)
436  rmix_day(1:nday,1:nnp) = rmix(iday(1:nday),1:nnp)
437  cwrho_day(1:nday,1:nnp) = cwrho(iday(1:nday),1:nnp)
438  cirho_day(1:nday,1:nnp) = cirho(iday(1:nday),1:nnp)
439  o3mix_day(1:nday,1:nnp) = o3mix(iday(1:nday),1:nnp)
440  acld_day(1:nday,1:nnp) = acld_loc(iday(1:nday),1:nnp)
441  b1_day(1:nday,1:nnp) = b1(iday(1:nday),1:nnp)
442  b2_day(1:nday,1:nnp) = b2(iday(1:nday),1:nnp)
443  b3_day(1:nday,1:nnp) = b3(iday(1:nday),1:nnp)
444  b4_day(1:nday,1:nnp) = b4(iday(1:nday),1:nnp)
445  pl2_day(1:nday,1:nnp+1) = pl2_loc(iday(1:nday),1:nnp+1)
446 
447 
448 ! print*,'---- enter subroutine bugs_swr:'
449  call bugs_swr
450  + ( nday , nnp , pl2_day , pl_day
451  +, dpl_day , tl_day , rmix_day , cwrho_day
452  +, cirho_day , o3mix_day , ts_day , amu0_day
453  +, slr_day , alvdf_day , alndf_day , alvdr_day
454  +, alndr_day , acld_day , acldmx_day , umco2
455  +, umch4 , umn2o , b1_day , b2_day
456  +, b3_day , b4_day , fdsw_day , fdswcl_day
457  +, fusw_day , fuswcl_day , radvbc_day , radvbcc_day
458  +, radvdc_day , radvdcc_day , radnbc_day , radnbcc_day
459  +, radndc_day , radndcc_day , sel_rules_sw
460  + )
461 
462 ! print*,'---- end subroutine bugs_swr:'
463 
464  radvbc_loc(iday(1:nday)) = radvbc_day(1:nday)
465  radvdc_loc(iday(1:nday)) = radvdc_day(1:nday)
466  radnbc_loc(iday(1:nday)) = radnbc_day(1:nday)
467  radndc_loc(iday(1:nday)) = radndc_day(1:nday)
468  radvbcc_loc(iday(1:nday)) = radvbcc_day(1:nday)
469  radvdcc_loc(iday(1:nday)) = radvdcc_day(1:nday)
470  radnbcc_loc(iday(1:nday)) = radnbcc_day(1:nday)
471  radndcc_loc(iday(1:nday)) = radndcc_day(1:nday)
472  fdsw(iday(1:nday),:) = fdsw_day(1:nday,:)
473  fdswcl(iday(1:nday),:) = fdswcl_day(1:nday,:)
474  fusw(iday(1:nday),:) = fusw_day(1:nday,:)
475  fuswcl(iday(1:nday),:) = fuswcl_day(1:nday,:)
476 
477  deallocate(ts_day)
478  deallocate(amu0_day)
479  deallocate(slr_day)
480  deallocate(alvdr_day)
481  deallocate(alndr_day)
482  deallocate(alvdf_day)
483  deallocate(alndf_day)
484  deallocate(acldmx_day)
485  deallocate(pl_day)
486  deallocate(dpl_day)
487  deallocate(tl_day)
488  deallocate(rmix_day)
489  deallocate(cwrho_day)
490  deallocate(cirho_day)
491  deallocate(o3mix_day)
492  deallocate(acld_day)
493  deallocate(pl2_day)
494  deallocate(b1_day)
495  deallocate(b2_day)
496  deallocate(b3_day)
497  deallocate(b4_day)
498  deallocate(radvbc_day)
499  deallocate(radvdc_day)
500  deallocate(radnbc_day)
501  deallocate(radndc_day)
502  deallocate(radvbcc_day)
503  deallocate(radvdcc_day)
504  deallocate(radnbcc_day)
505  deallocate(radndcc_day)
506  deallocate(fdsw_day)
507  deallocate(fdswcl_day)
508  deallocate(fusw_day)
509  deallocate(fuswcl_day)
510 
511 
512  1000 continue
513 
514 !---- 5. computation of long and short wave radiative heating rates:
515  do l = 1, nlm
516  ll = l
517  delf(1:len) = fulw(1:len,ll)-fdlw(1:len,ll)
518  + - fulw(1:len,ll+1)+fdlw(1:len,ll+1)
519  delfcl(1:len) = fulwcl(1:len,ll)-fdlwcl(1:len,ll)
520  + - fulwcl(1:len,ll+1)+ fdlwcl(1:len,ll+1)
521  atl(1:len,l) = -heat_fac*delf/dpl(1:len,l)
522  atlcl(1:len,l) = -heat_fac*delfcl/dpl(1:len,l)
523 
524  delf(1:len) = fusw(1:len,ll)-fdsw(1:len,ll)
525  + - fusw(1:len,ll+1)+fdsw(1:len,ll+1)
526  delfcl(1:len) = fuswcl(1:len,ll)-fdswcl(1:len,ll)
527  + - fuswcl(1:len,ll+1) + fdswcl(1:len,ll+1)
528  asl(1:len,l) = -heat_fac*delf/dpl(1:len,l)
529  aslcl(1:len,l) = -heat_fac*delfcl/dpl(1:len,l)
530  enddo
531 
532 
533 !---- back to full arrays:
534  radvbc(1:len) = radvbc_loc(1:len)
535  radvdc(1:len) = radvdc_loc(1:len)
536  radnbc(1:len) = radnbc_loc(1:len)
537  radndc(1:len) = radndc_loc(1:len)
538  radvbcc(1:len) = radvbcc_loc(1:len)
539  radvdcc(1:len) = radvdcc_loc(1:len)
540  radnbcc(1:len) = radnbcc_loc(1:len)
541  radndcc(1:len) = radndcc_loc(1:len)
542 
543 
544 ! print*,'---- exit subroutine bugs_rad:'
545  return
546  end subroutine bugs_rad
547 
548 !----------------------------------------------------------------------