BUGSrad
 All Classes Files Functions Variables
continuum.f90
Go to the documentation of this file.
1 
2 
3 ! CVS: $Id: continuum.F90,v 1.1 2007/05/30 15:52:47 norm Exp $
4 ! CVS: $Name: $
5 module continuum
6 
7 use kinds
8 implicit none
9 
10 integer (kind=int_kind), parameter :: &
11  ncoef = 7 &
12  , nreg = 2 &
13  , nband = 12
14 
15 real (kind=dbl_kind), dimension(nband) :: &
16  h2obnd
17 
18 real (kind=dbl_kind), dimension(ncoef,nreg,nband):: &
19  ck24_3 !weighted by Planck function
20 
21 data h2obnd /-5,-3.5,-2.0,-2,-1.,-4,-4,-4,-3,-3.5,-3,-2/
22 
23 data ck24_3/ & !ckd24fu.fuliou.lin.plnk.out
24 ! band 1
25  1.667e+00, 9.421e-01,-7.358e-03, 1.355e+00, &
26  2.557e+03, 5.798e+01,-4.570e-01, &
27 ! band 1
28  6.417e+00, 1.002e+00,-6.991e-03, 1.010e+00, &
29  1.203e+01, 4.501e-02,-2.428e-02, &
30 ! band 2
31  2.390e+00, 9.528e-01,-6.058e-03, 1.071e+00, &
32  2.676e+02, 9.848e+00,-1.459e-01, &
33 ! band 2
34  4.849e+00, 1.002e+00,-6.910e-03, 8.961e-01, &
35  1.635e+01, 2.115e-02, 7.243e-02, &
36 ! band 3
37  2.326e+00, 9.720e-01,-6.551e-03, 8.739e-01, &
38  6.984e+01, 8.346e-01, 4.824e-02, &
39 ! band 3
40  5.002e+00, 1.005e+00,-9.286e-03, 6.222e-01, &
41  1.168e+01, 3.611e-03, 3.148e-01, &
42 ! band 4
43  -4.865e+00, 8.455e-01,-6.911e-03, 1.475e+00,&
44  2.905e+02, 7.078e+00,-6.846e-01, &
45 ! band 4
46  4.596e+00, 1.012e+00,-1.152e-02, 5.713e-01, &
47  1.270e+01,-1.395e-03, 3.447e-01, &
48 ! band 5
49  -5.396e+00, 8.596e-01,-8.479e-03, 1.619e+00,&
50  1.664e+02, 3.236e+00,-7.782e-01, &
51 ! band 5
52  7.478e+00, 1.007e+00,-1.963e-02, 2.771e-01, &
53  6.021e+00,-4.489e-03, 6.709e-01, &
54 ! band 6
55  1.262e+00, 2.347e-01,-2.360e-02, 1.655e-01, &
56  5.068e+02, 2.462e+01, 3.920e-01, &
57 ! band 6
58  9.334e+00, 1.002e+00,-2.429e-02, 3.575e-02, &
59  2.751e-01,-1.189e-03, 9.593e-01, &
60 ! band 7
61  -1.222e+00, 5.423e-01,-2.327e-02, 5.197e-01,&
62  6.423e+02, 5.038e+01, 1.502e-01, &
63 ! band 7
64  8.506e+00, 1.000e+00,-2.339e-02, 8.891e-03, &
65  -6.805e-01,-1.639e-04, 9.917e-01, &
66 ! band 8
67  -3.638e+00, 8.534e-01,-1.344e-02, 6.816e-01,&
68  5.385e+02, 4.428e+01,-6.366e-03, &
69 ! band 8
70  6.921e+00, 1.002e+00,-1.974e-02, 6.350e-02, &
71  6.838e-01,-1.121e-03, 9.237e-01, &
72 ! band 9
73  -2.329e+00, 7.893e-01,-2.588e-03, 1.017e+00,&
74  1.525e+02, 1.029e+01,-1.486e-01, &
75 ! band 9
76  6.742e-01, 1.008e+00,-3.376e-03, 9.105e-01, &
77  1.074e+01,-3.307e-03, 5.741e-02, &
78 ! band 10
79  -1.677e+00, 9.173e-01,-5.780e-03, 1.504e+00,&
80  7.886e+02, 2.288e+01,-5.999e-01, &
81 ! band 10
82  3.396e+00, 1.005e+00,-3.433e-03, 1.012e+00, &
83  7.635e+00, 3.010e-03,-2.418e-02, &
84 ! band 11
85  7.943e-01, 9.260e-01,-5.050e-03, 1.141e+00, &
86  2.221e+02, 1.021e+01,-2.246e-01, &
87 ! band 11
88  3.356e+00, 1.002e+00,-4.719e-03, 9.578e-01, &
89  6.164e+00, 1.186e-03, 2.264e-02, &
90 ! band 12
91  -5.874e+00, 7.060e-01,-1.532e-03, 1.141e+00,&
92  1.463e+02, 6.534e+00,-4.308e-01, &
93 ! band 12
94  4.709e-01, 1.010e+00,-6.067e-03, 8.513e-01, &
95  1.161e+01,-6.629e-03, 8.885e-02 &
96  /
97 
98 
99 contains
100 
101 subroutine gascon &
102  (ncol, nlm, ib, pp &
103  ,ppl, dp, tt, rmix &
104  ,tgm )
105 
106  use kinds, only: int_kind, dbl_kind
107  use bugsrad_physconst, only: gravity, r_d, f_virt
108  implicit none
109 
110 !-----------------------------------------------------------------------
111 ! MODIFICATIONS:
112 ! * changed declarations to adapt the code from BUGS4 to BUGS5.
113 ! Laura D. Fowler/slikrock (02-01-00).
114 
115 ! NBW - Modified 27/11/2002
116 ! H2O continuum now based on CKD2.4, from Fred Rose and Dave Kurtz
117 
118 ! REFERENCES:
119 ! Parameterized CKD_2.1 continuum absorption.
120 ! adapted from the Fu-Liou 4-stream radiative transfer model original
121 ! code by Fred Rose. use radparams_0898.
122 ! Phil Partain/graben (04/04/00).
123 
124 ! send comments to partain@atmos.colostate.edu.
125 
126 ! SUBROUTINES CALLED:
127 ! none.
128 
129 ! FUNCTIONS CALLED:
130 ! none.
131 
132 ! INCLUDED COMMONS:
133 ! none.
134 
135 ! ARGUMENT LIST VARIABLES:
136 ! INPUT ARGUMENTS:
137 ! ----------------
138  integer (kind=int_kind), intent(in):: &
139  ncol & !Length of sub-domain.
140  ,nlm & !Number of layers.
141  ,ib !Spectral interval.
142 
143  real (kind=dbl_kind), intent(in), dimension(:,:):: &
144  ppl & !Pressure (hPa).
145  ,dp & !Pressure thickness (hPa).
146  ,tt & !Temperature (K).
147  ,rmix & !Water vapor mixing ratio (kg/kg).
148  ,pp
149 
150 ! OUTPUT ARGUMENTS:
151 ! -----------------
152  real (kind=dbl_kind), intent(out), dimension(:,:):: &
153  tgm !Water vapor continuum optical depth (-).
154 
155 ! LOCAL VARIABLES:
156 
157  integer (kind=int_kind):: &
158  i,l
159 
160  integer (kind=int_kind), dimension(18):: &
161  iflb
162  data iflb /6*0,12,11,10,9,8,7,6,5,4,3,2,1/
163 
164  real (kind=dbl_kind):: &
165  dz, amnt, patm, tv
166 
167  tgm(:,:) = 0.
168  if( iflb(ib) .eq. 0) return
169  do i = 1, ncol
170  do l = 1, nlm
171  if(rmix(i,l).gt.0.0) then
172  ! The factor of 10 converts hPa to Pa and kg/m^2 to g/cm^2
173  amnt = 10._dbl_kind*dp(i,l)*rmix(i,l)/gravity
174  patm = ppl(i,l) /1013.25_dbl_kind
175  tv = tt(i,l)*(1._dbl_kind + f_virt*rmix(i,l))
176  dz = (r_d/gravity)*tv*log(pp(i,l+1)/pp(i,l))* &
177  0.001_dbl_kind
178  tgm(i,l) = parm_ckd24(iflb(ib),amnt,patm,tt(i,l),dz)
179  endif
180  enddo
181  enddo
182 
183  return
184 end subroutine gascon
185 
186 function parm_ckd24(iband,amnt,patm,temp,dz) result(ckd24_tau)
187  use kinds
188  use bugsrad_physconst, only: r_star,mw_h2o
189  implicit none
190 ! Parameterization of CKD_2.4 continuum over Fu-Liou Bands
191 ! Input:
192 ! iband = integer (1-12) where
193 ! Band 1 =' 5:280cm-1'
194 ! Band 2 ='280:400cm-1'
195 ! Band 3 ='400:540cm-1'
196 ! Band 4 ='540:670cm-1'
197 ! Band 5 ='670:800cm-1'
198 ! Band 6 ='800:980cm-1'
199 ! Band 7 ='980:1100cm-1'
200 ! Band 8 ='1100:1250cm-1'
201 ! Band 9 ='1250:1400cm-1'
202 ! Band10 ='1400:1700cm-1'
203 ! Band11 ='1700:1900cm-1'
204 ! Band12 ='1900:2200cm-1'
205 ! amnt = h2O ammount (g/cm**2)
206 ! patm = pressure (atm)
207 ! temp = temperature (k)
208 ! dz = pathlength (Km)
209 ! Output:
210 ! parm_ckd24 = parameterized CKD_2.4optical depth for band
211 !234567890123456789012345678901234567890123456789012345678901234567890
212 
213 
214 
215 ! These Regressions are more sensitive to pathlength
216 ! So accomodations for very Thin or Thick layers are made.
217 
218  integer (kind=int_kind), intent(in):: &
219  iband
220 
221  real (kind=dbl_kind), intent(in):: &
222  amnt & !Water vapor content (g/cm^2).
223  ,patm & !Pressure (atm).
224  ,temp & !Temperature (K).
225  ,dz !Path length (km).
226 
227 ! OUTPUT ARGUMENTS:
228  real (kind=dbl_kind):: &
229  ckd24_tau !Optical depth to water vapor continuum (-).
230 
231 ! LOCAL VARIABLES:
232  integer(kind=int_kind) :: &
233  ireg
234 
235  real (kind=dbl_kind):: &
236  factor, dz1, amnt1, patmx, ph2o, tau_log
237 
238  dz1 =dz
239  factor=1.000
240  if ( dz < 0.25 ) then
241  factor = 0.25/dz
242  dz1 = 0.25
243  elseif (dz > 1.50) then
244  factor = 1.50/dz
245  dz1 = 1.50
246  endif
247  amnt1=amnt*factor
248 
249 ! Regression is now broken up into TWO parts one for small
250 ! one for large water vapor ammounts.
251 
252  ireg=1
253  if (log(amnt1) > h2obnd(iband)) ireg=2
254 
255  ph2o = amnt1 *(r_star*1.e4_dbl_kind*temp )/ &
256  (dz1*1.0d+05*mw_h2o *1.01325d+06)
257 
258  patmx = log(patm)
259  tau_log = ck24_3(1,ireg,iband) + &
260  ck24_3(2,ireg,iband)* log(amnt1) + &
261  ck24_3(3,ireg,iband)* temp + &
262  ck24_3(4,ireg,iband)* patmx + &
263  ck24_3(5,ireg,iband)* (ph2o) + &
264  ck24_3(6,ireg,iband)* amnt1 + &
265  ck24_3(7,ireg,iband)* log(ph2o)
266  ckd24_tau = exp( tau_log )
267  ckd24_tau = ckd24_tau/factor
268  return
269 end function parm_ckd24
270 
271 
272 end module continuum