BUGSrad
 All Classes Files Functions Variables
two_rt_lw_sel.f
Go to the documentation of this file.
1 
2 
3 ! CVS: $Id: two_rt_lw_sel.F,v 1.3 2003/11/11 21:55:13 norm Exp $
4 ! CVS: $Name: $
5 
6 
7 !-----------------------------------------------------------------------
8 
9  subroutine two_rt_lw_sel
10  + (
11  + ncol , nlm , mbs , mbir , ib
12  +, tauclr , es , bf , fu , fd
13  + )
14 
15  use kinds
16 
17 
18 
19 
20  implicit none
21 
22 !-----------------------------------------------------------------------
23 ! REFERENCES:
24 ! two_rt_lw replaces two_rt and add written by G. Stephens. two_rt_lw
25 ! computes the spectral fluxes using a two-stream approximation method.
26 ! Philip Partain, Philip Gabriel, and Laura D. Fowler/graben (09-08-99).
27 
28 ! MODIFICATIONS:
29 ! * changed declarations to adapt the code from BUGS4 to BUGS5.
30 ! Laura D. Fowler/slikrock (02-01-00).
31 
32 ! SUBROUTINES CALLED:
33 ! none.
34 
35 ! FUNCTIONS CALLED:
36 ! none.
37 
38 ! INCLUDED COMMONS:
39 ! none.
40 
41 ! ARGUMENT LIST VARIABLES:
42 ! All arrays indexed as nlm correspond to variables defined in the
43 ! middle of layers. All arrays indexed as nlm+1 correspond to variables
44 ! defined at levels at the top and bottom of layers.
45 
46 ! INPUT ARGUMENTS:
47 ! ----------------
48  integer (kind=int_kind), intent(in)::
49  & ncol !Length of sub-domain.
50  &, nlm !Number of layers.
51  &, mbs !Number of SW spectral intervals.
52  &, mbir !Number of IR spectral intervals.
53  &, ib !Index of spectral interval.
54 
55  real (kind=dbl_kind), intent(in), dimension(ncol,mbir)::
56  & es ! Spectral surface emissivity (-).
57  real (kind=dbl_kind), intent(in), dimension(ncol,nlm)::
58  & tauclr !Optical depth (-).
59  real (kind=dbl_kind), intent(in), dimension(ncol,nlm+1)::
60  & bf !Planck function (-).
61 
62 ! OUTPUT ARGUMENTS:
63 ! -----------------
64  real (kind=dbl_kind), intent(out), dimension(ncol,nlm+1)::
65  & fd !Spectral downward flux (W/m^2).
66  &, fu !Spectral upward flux (W/m^2).
67 
68 ! LOCAL VARIABLES:
69 
70  integer(kind=int_kind)
71  & i !Horizontal index.
72  &, l !Vertical index.
73  &, ibms !Index of spectral interval.
74 
75  real (kind=dbl_kind), dimension(nlm)::
76  & sigu
77  &, sigd
78  &, exptau
79 
80  real(kind=dbl_kind)
81  & aa
82  &, bb
83  &, cc
84  &, prop
85 
86 !----------------------------------------------------------------------
87 
88 
89  ibms = ib - mbs
90 
91  do 1000 i = 1, ncol
92 
93  !TOA/BOA initializations
94  fu(i,nlm+1) = bf(i,nlm+1)*es(i,ibms)
95  fd(i,1) = 0.
96 
97  do l=1,nlm
98  exptau(l) = exp(-2*tauclr(i,l))
99  if(tauclr(i,l) .lt. .8e-2) then
100  sigu(l) = (bf(i,l)+bf(i,l+1))*tauclr(i,l)
101  sigd(l) = sigu(l)
102  else
103  prop = (1.-exptau(l))/tauclr(i,l)
104  aa = 2.-prop
105  bb = -2.*exptau(l)+prop
106  cc = 0.5
107  sigu(l) = (aa*bf(i,l)+bb*bf(i,l+1))*cc
108  sigd(l) = (bb*bf(i,l)+aa*bf(i,l+1))*cc
109  endif
110  fd(i,l+1) = sigd(l) + exptau(l) * fd(i,l)
111  enddo
112 
113  do l=nlm,1,-1
114  fu(i,l) = sigu(l) + exptau(l) * fu(i,l+1)
115  enddo
116 
117 1000 continue
118 
119  return
120  end