Home

Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

rrtmg_lw_init.f90 @ 3359

Last change on this file since 3359 was 1585, checked in by maronga, 10 years ago
Added support for RRTMG radiation code
File size: 107.7 KB

Line
1	! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_init.f90,v $
2	! author: $Author: miacono $
3	! revision: $Revision: 1.6 $
4	! created: $Date: 2011/04/08 20:25:01 $
5	!
6	module rrtmg_lw_init
7
8	! --------------------------------------------------------------------------
9	! \| \|
10	! \| Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER). \|
11	! \| This software may be used, copied, or redistributed as long as it is \|
12	! \| not sold and this copyright notice is reproduced on each copy made. \|
13	! \| This model is provided as is without any express or implied warranties. \|
14	! \| (http://www.rtweb.aer.com/) \|
15	! \| \|
16	! --------------------------------------------------------------------------
17
18	! ------- Modules -------
19	use parkind, only : im => kind_im, rb => kind_rb
20	use rrlw_wvn
21	use rrtmg_lw_setcoef, only: lwatmref, lwavplank, lwavplankderiv
22
23	implicit none
24
25	contains
26
27	! **************************************************************************
28	subroutine rrtmg_lw_ini(cpdair)
29	! **************************************************************************
30	!
31	! Original version: Michael J. Iacono; July, 1998
32	! First revision for GCMs: September, 1998
33	! Second revision for RRTM_V3.0: September, 2002
34	!
35	! This subroutine performs calculations necessary for the initialization
36	! of the longwave model. Lookup tables are computed for use in the LW
37	! radiative transfer, and input absorption coefficient data for each
38	! spectral band are reduced from 256 g-point intervals to 140.
39	! **************************************************************************
40
41	use parrrtm, only : mg, nbndlw, ngptlw
42	use rrlw_tbl, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl, tfn_tbl
43	use rrlw_vsn, only: hvrini, hnamini
44
45	real(kind=rb), intent(in) :: cpdair ! Specific heat capacity of dry air
46	! at constant pressure at 273 K
47	! (J kg-1 K-1)
48
49	! ------- Local -------
50
51	integer(kind=im) :: itr, ibnd, igc, ig, ind, ipr
52	integer(kind=im) :: igcsm, iprsm
53
54	real(kind=rb) :: wtsum, wtsm(mg) !
55	real(kind=rb) :: tfn !
56
57	real(kind=rb), parameter :: expeps = 1.e-20_rb ! Smallest value for exponential table
58
59	! ------- Definitions -------
60	! Arrays for 10000-point look-up tables:
61	! TAU_TBL Clear-sky optical depth (used in cloudy radiative transfer)
62	! EXP_TBL Exponential lookup table for ransmittance
63	! TFN_TBL Tau transition function; i.e. the transition of the Planck
64	! function from that for the mean layer temperature to that for
65	! the layer boundary temperature as a function of optical depth.
66	! The "linear in tau" method is used to make the table.
67	! PADE Pade approximation constant (= 0.278)
68	! BPADE Inverse of the Pade approximation constant
69	!
70
71	hvrini = '$Revision: 1.6 $'
72
73	! Initialize model data
74	call lwdatinit(cpdair)
75	call lwcmbdat ! g-point interval reduction data
76	call lwcldpr ! cloud optical properties
77	call lwatmref ! reference MLS profile
78	call lwavplank ! Planck function
79	call lwavplankderiv ! Planck function derivative wrt temp
80	call lw_kgb01 ! molecular absorption coefficients
81	call lw_kgb02
82	call lw_kgb03
83	call lw_kgb04
84	call lw_kgb05
85	call lw_kgb06
86	call lw_kgb07
87	call lw_kgb08
88	call lw_kgb09
89	call lw_kgb10
90	call lw_kgb11
91	call lw_kgb12
92	call lw_kgb13
93	call lw_kgb14
94	call lw_kgb15
95	call lw_kgb16
96
97	! Compute lookup tables for transmittance, tau transition function,
98	! and clear sky tau (for the cloudy sky radiative transfer). Tau is
99	! computed as a function of the tau transition function, transmittance
100	! is calculated as a function of tau, and the tau transition function
101	! is calculated using the linear in tau formulation at values of tau
102	! above 0.01. TF is approximated as tau/6 for tau < 0.01. All tables
103	! are computed at intervals of 0.001. The inverse of the constant used
104	! in the Pade approximation to the tau transition function is set to b.
105
106	tau_tbl(0) = 0.0_rb
107	tau_tbl(ntbl) = 1.e10_rb
108	exp_tbl(0) = 1.0_rb
109	exp_tbl(ntbl) = expeps
110	tfn_tbl(0) = 0.0_rb
111	tfn_tbl(ntbl) = 1.0_rb
112	bpade = 1.0_rb / pade
113	do itr = 1, ntbl-1
114	tfn = real(itr) / real(ntbl)
115	tau_tbl(itr) = bpade * tfn / (1._rb - tfn)
116	exp_tbl(itr) = exp(-tau_tbl(itr))
117	if (exp_tbl(itr) .le. expeps) exp_tbl(itr) = expeps
118	if (tau_tbl(itr) .lt. 0.06_rb) then
119	tfn_tbl(itr) = tau_tbl(itr)/6._rb
120	else
121	tfn_tbl(itr) = 1._rb-2._rb*((1._rb/tau_tbl(itr))-(exp_tbl(itr)/(1.-exp_tbl(itr))))
122	endif
123	enddo
124
125	! Perform g-point reduction from 16 per band (256 total points) to
126	! a band dependant number (140 total points) for all absorption
127	! coefficient input data and Planck fraction input data.
128	! Compute relative weighting for new g-point combinations.
129
130	igcsm = 0
131	do ibnd = 1,nbndlw
132	iprsm = 0
133	if (ngc(ibnd).lt.mg) then
134	do igc = 1,ngc(ibnd)
135	igcsm = igcsm + 1
136	wtsum = 0._rb
137	do ipr = 1, ngn(igcsm)
138	iprsm = iprsm + 1
139	wtsum = wtsum + wt(iprsm)
140	enddo
141	wtsm(igc) = wtsum
142	enddo
143	do ig = 1, ng(ibnd)
144	ind = (ibnd-1)*mg + ig
145	rwgt(ind) = wt(ig)/wtsm(ngm(ind))
146	enddo
147	else
148	do ig = 1, ng(ibnd)
149	igcsm = igcsm + 1
150	ind = (ibnd-1)*mg + ig
151	rwgt(ind) = 1.0_rb
152	enddo
153	endif
154	enddo
155
156	! Reduce g-points for absorption coefficient data in each LW spectral band.
157
158	call cmbgb1
159	call cmbgb2
160	call cmbgb3
161	call cmbgb4
162	call cmbgb5
163	call cmbgb6
164	call cmbgb7
165	call cmbgb8
166	call cmbgb9
167	call cmbgb10
168	call cmbgb11
169	call cmbgb12
170	call cmbgb13
171	call cmbgb14
172	call cmbgb15
173	call cmbgb16
174
175	end subroutine rrtmg_lw_ini
176
177	!***************************************************************************
178	subroutine lwdatinit(cpdair)
179	!***************************************************************************
180
181	! --------- Modules ----------
182
183	use parrrtm, only : maxxsec, maxinpx
184	use rrlw_con, only: heatfac, grav, planck, boltz, &
185	clight, avogad, alosmt, gascon, radcn1, radcn2, &
186	sbcnst, secdy
187	use rrlw_vsn
188
189	save
190
191	real(kind=rb), intent(in) :: cpdair ! Specific heat capacity of dry air
192	! at constant pressure at 273 K
193	! (J kg-1 K-1)
194
195	! Longwave spectral band limits (wavenumbers)
196	wavenum1(:) = (/ 10._rb, 350._rb, 500._rb, 630._rb, 700._rb, 820._rb, &
197	980._rb,1080._rb,1180._rb,1390._rb,1480._rb,1800._rb, &
198	2080._rb,2250._rb,2380._rb,2600._rb/)
199	wavenum2(:) = (/350._rb, 500._rb, 630._rb, 700._rb, 820._rb, 980._rb, &
200	1080._rb,1180._rb,1390._rb,1480._rb,1800._rb,2080._rb, &
201	2250._rb,2380._rb,2600._rb,3250._rb/)
202	delwave(:) = (/340._rb, 150._rb, 130._rb, 70._rb, 120._rb, 160._rb, &
203	100._rb, 100._rb, 210._rb, 90._rb, 320._rb, 280._rb, &
204	170._rb, 130._rb, 220._rb, 650._rb/)
205
206	! Spectral band information
207	ng(:) = (/16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/)
208	nspa(:) = (/1,1,9,9,9,1,9,1,9,1,1,9,9,1,9,9/)
209	nspb(:) = (/1,1,5,5,5,0,1,1,1,1,1,0,0,1,0,0/)
210
211	! nxmol - number of cross-sections input by user
212	! ixindx(i) - index of cross-section molecule corresponding to Ith
213	! cross-section specified by user
214	! = 0 -- not allowed in rrtm
215	! = 1 -- ccl4
216	! = 2 -- cfc11
217	! = 3 -- cfc12
218	! = 4 -- cfc22
219	nxmol = 4
220	ixindx(1) = 1
221	ixindx(2) = 2
222	ixindx(3) = 3
223	ixindx(4) = 4
224	ixindx(5:maxinpx) = 0
225
226	! Fundamental physical constants from NIST 2002
227
228	grav = 9.8066_rb ! Acceleration of gravity
229	! (m s-2)
230	planck = 6.62606876e-27_rb ! Planck constant
231	! (ergs s; g cm2 s-1)
232	boltz = 1.3806503e-16_rb ! Boltzmann constant
233	! (ergs K-1; g cm2 s-2 K-1)
234	clight = 2.99792458e+10_rb ! Speed of light in a vacuum
235	! (cm s-1)
236	avogad = 6.02214199e+23_rb ! Avogadro constant
237	! (mol-1)
238	alosmt = 2.6867775e+19_rb ! Loschmidt constant
239	! (cm-3)
240	gascon = 8.31447200e+07_rb ! Molar gas constant
241	! (ergs mol-1 K-1)
242	radcn1 = 1.191042722e-12_rb ! First radiation constant
243	! (W cm2 sr-1)
244	radcn2 = 1.4387752_rb ! Second radiation constant
245	! (cm K)
246	sbcnst = 5.670400e-04_rb ! Stefan-Boltzmann constant
247	! (W cm-2 K-4)
248	secdy = 8.6400e4_rb ! Number of seconds per day
249	! (s d-1)
250	!
251	! units are generally cgs
252	!
253	! The first and second radiation constants are taken from NIST.
254	! They were previously obtained from the relations:
255	! radcn1 = 2.planckclightclight1.e-07
256	! radcn2 = planck*clight/boltz
257
258	! Heatfac is the factor by which delta-flux / delta-pressure is
259	! multiplied, with flux in W/m-2 and pressure in mbar, to get
260	! the heating rate in units of degrees/day. It is equal to:
261	! Original value:
262	! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
263	! Here, cpdair (1.004) is in units of J g-1 K-1, and the
264	! constant (1.e-5) converts mb to Pa and g-1 to kg-1.
265	! = (9.8066)(86400)(1e-5)/(1.004)
266	! heatfac = 8.4391_rb
267	!
268	! Modified value for consistency with CAM3:
269	! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
270	! Here, cpdair (1.00464) is in units of J g-1 K-1, and the
271	! constant (1.e-5) converts mb to Pa and g-1 to kg-1.
272	! = (9.80616)(86400)(1e-5)/(1.00464)
273	! heatfac = 8.43339130434_rb
274	!
275	! Calculated value:
276	! (grav) x (#sec/day) / (specific heat of dry air at const. p x 1.e2)
277	! Here, cpdair is in units of J kg-1 K-1, and the constant (1.e2)
278	! converts mb to Pa when heatfac is multiplied by W m-2 mb-1.
279	heatfac = grav * secdy / (cpdair * 1.e2_rb)
280
281	end subroutine lwdatinit
282
283	!***************************************************************************
284	subroutine lwcmbdat
285	!***************************************************************************
286
287	save
288
289	! ------- Definitions -------
290	! Arrays for the g-point reduction from 256 to 140 for the 16 LW bands:
291	! This mapping from 256 to 140 points has been carefully selected to
292	! minimize the effect on the resulting fluxes and cooling rates, and
293	! caution should be used if the mapping is modified. The full 256
294	! g-point set can be restored with ngptlw=256, ngc=1616, ngn=2561., etc.
295	! ngptlw The total number of new g-points
296	! ngc The number of new g-points in each band
297	! ngs The cumulative sum of new g-points for each band
298	! ngm The index of each new g-point relative to the original
299	! 16 g-points for each band.
300	! ngn The number of original g-points that are combined to make
301	! each new g-point in each band.
302	! ngb The band index for each new g-point.
303	! wt RRTM weights for 16 g-points.
304
305	! ------- Data statements -------
306	ngc(:) = (/10,12,16,14,16,8,12,8,12,6,8,8,4,2,2,2/)
307	ngs(:) = (/10,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/)
308	ngm(:) = (/1,2,3,3,4,4,5,5,6,6,7,7,8,8,9,10, & ! band 1
309	1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, & ! band 2
310	1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 3
311	1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, & ! band 4
312	1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! band 5
313	1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! band 6
314	1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, & ! band 7
315	1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! band 8
316	1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, & ! band 9
317	1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, & ! band 10
318	1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, & ! band 11
319	1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, & ! band 12
320	1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, & ! band 13
321	1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! band 14
322	1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! band 15
323	1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2/) ! band 16
324	ngn(:) = (/1,1,2,2,2,2,2,2,1,1, & ! band 1
325	1,1,1,1,1,1,1,1,2,2,2,2, & ! band 2
326	1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 3
327	1,1,1,1,1,1,1,1,1,1,1,1,1,3, & ! band 4
328	1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, & ! band 5
329	2,2,2,2,2,2,2,2, & ! band 6
330	2,2,1,1,1,1,1,1,1,1,2,2, & ! band 7
331	2,2,2,2,2,2,2,2, & ! band 8
332	1,1,1,1,1,1,1,1,2,2,2,2, & ! band 9
333	2,2,2,2,4,4, & ! band 10
334	1,1,2,2,2,2,3,3, & ! band 11
335	1,1,1,1,2,2,4,4, & ! band 12
336	3,3,4,6, & ! band 13
337	8,8, & ! band 14
338	8,8, & ! band 15
339	4,12/) ! band 16
340	ngb(:) = (/1,1,1,1,1,1,1,1,1,1, & ! band 1
341	2,2,2,2,2,2,2,2,2,2,2,2, & ! band 2
342	3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, & ! band 3
343	4,4,4,4,4,4,4,4,4,4,4,4,4,4, & ! band 4
344	5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, & ! band 5
345	6,6,6,6,6,6,6,6, & ! band 6
346	7,7,7,7,7,7,7,7,7,7,7,7, & ! band 7
347	8,8,8,8,8,8,8,8, & ! band 8
348	9,9,9,9,9,9,9,9,9,9,9,9, & ! band 9
349	10,10,10,10,10,10, & ! band 10
350	11,11,11,11,11,11,11,11, & ! band 11
351	12,12,12,12,12,12,12,12, & ! band 12
352	13,13,13,13, & ! band 13
353	14,14, & ! band 14
354	15,15, & ! band 15
355	16,16/) ! band 16
356	wt(:) = (/ 0.1527534276_rb, 0.1491729617_rb, 0.1420961469_rb, &
357	0.1316886544_rb, 0.1181945205_rb, 0.1019300893_rb, &
358	0.0832767040_rb, 0.0626720116_rb, 0.0424925000_rb, &
359	0.0046269894_rb, 0.0038279891_rb, 0.0030260086_rb, &
360	0.0022199750_rb, 0.0014140010_rb, 0.0005330000_rb, &
361	0.0000750000_rb/)
362
363	end subroutine lwcmbdat
364
365	!***************************************************************************
366	subroutine cmbgb1
367	!***************************************************************************
368	!
369	! Original version: MJIacono; July 1998
370	! Revision for GCMs: MJIacono; September 1998
371	! Revision for RRTMG: MJIacono, September 2002
372	! Revision for F90 reformatting: MJIacono, June 2006
373	!
374	! The subroutines CMBGB1->CMBGB16 input the absorption coefficient
375	! data for each band, which are defined for 16 g-points and 16 spectral
376	! bands. The data are combined with appropriate weighting following the
377	! g-point mapping arrays specified in RRTMINIT. Plank fraction data
378	! in arrays FRACREFA and FRACREFB are combined without weighting. All
379	! g-point reduced data are put into new arrays for use in RRTM.
380	!
381	! band 1: 10-350 cm-1 (low key - h2o; low minor - n2)
382	! (high key - h2o; high minor - n2)
383	! note: previous versions of rrtm band 1:
384	! 10-250 cm-1 (low - h2o; high - h2o)
385	!***************************************************************************
386
387	use parrrtm, only : mg, nbndlw, ngptlw, ng1
388	use rrlw_kg01, only: fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, &
389	selfrefo, forrefo, &
390	fracrefa, fracrefb, absa, ka, absb, kb, ka_mn2, kb_mn2, &
391	selfref, forref
392
393	! ------- Local -------
394	integer(kind=im) :: jt, jp, igc, ipr, iprsm
395	real(kind=rb) :: sumk, sumk1, sumk2, sumf1, sumf2
396
397
398	do jt = 1,5
399	do jp = 1,13
400	iprsm = 0
401	do igc = 1,ngc(1)
402	sumk = 0.
403	do ipr = 1, ngn(igc)
404	iprsm = iprsm + 1
405	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm)
406	enddo
407	ka(jt,jp,igc) = sumk
408	enddo
409	enddo
410	do jp = 13,59
411	iprsm = 0
412	do igc = 1,ngc(1)
413	sumk = 0.
414	do ipr = 1, ngn(igc)
415	iprsm = iprsm + 1
416	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm)
417	enddo
418	kb(jt,jp,igc) = sumk
419	enddo
420	enddo
421	enddo
422
423	do jt = 1,10
424	iprsm = 0
425	do igc = 1,ngc(1)
426	sumk = 0.
427	do ipr = 1, ngn(igc)
428	iprsm = iprsm + 1
429	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm)
430	enddo
431	selfref(jt,igc) = sumk
432	enddo
433	enddo
434
435	do jt = 1,4
436	iprsm = 0
437	do igc = 1,ngc(1)
438	sumk = 0.
439	do ipr = 1, ngn(igc)
440	iprsm = iprsm + 1
441	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm)
442	enddo
443	forref(jt,igc) = sumk
444	enddo
445	enddo
446
447	do jt = 1,19
448	iprsm = 0
449	do igc = 1,ngc(1)
450	sumk1 = 0.
451	sumk2 = 0.
452	do ipr = 1, ngn(igc)
453	iprsm = iprsm + 1
454	sumk1 = sumk1 + kao_mn2(jt,iprsm)*rwgt(iprsm)
455	sumk2 = sumk2 + kbo_mn2(jt,iprsm)*rwgt(iprsm)
456	enddo
457	ka_mn2(jt,igc) = sumk1
458	kb_mn2(jt,igc) = sumk2
459	enddo
460	enddo
461
462	iprsm = 0
463	do igc = 1,ngc(1)
464	sumf1 = 0.
465	sumf2 = 0.
466	do ipr = 1, ngn(igc)
467	iprsm = iprsm + 1
468	sumf1= sumf1+ fracrefao(iprsm)
469	sumf2= sumf2+ fracrefbo(iprsm)
470	enddo
471	fracrefa(igc) = sumf1
472	fracrefb(igc) = sumf2
473	enddo
474
475	end subroutine cmbgb1
476
477	!***************************************************************************
478	subroutine cmbgb2
479	!***************************************************************************
480	!
481	! band 2: 350-500 cm-1 (low key - h2o; high key - h2o)
482	!
483	! note: previous version of rrtm band 2:
484	! 250 - 500 cm-1 (low - h2o; high - h2o)
485	!***************************************************************************
486
487	use parrrtm, only : mg, nbndlw, ngptlw, ng2
488	use rrlw_kg02, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
489	fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref
490
491	! ------- Local -------
492	integer(kind=im) :: jt, jp, igc, ipr, iprsm
493	real(kind=rb) :: sumk, sumf1, sumf2
494
495
496	do jt = 1,5
497	do jp = 1,13
498	iprsm = 0
499	do igc = 1,ngc(2)
500	sumk = 0.
501	do ipr = 1, ngn(ngs(1)+igc)
502	iprsm = iprsm + 1
503	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+16)
504	enddo
505	ka(jt,jp,igc) = sumk
506	enddo
507	enddo
508	do jp = 13,59
509	iprsm = 0
510	do igc = 1,ngc(2)
511	sumk = 0.
512	do ipr = 1, ngn(ngs(1)+igc)
513	iprsm = iprsm + 1
514	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+16)
515	enddo
516	kb(jt,jp,igc) = sumk
517	enddo
518	enddo
519	enddo
520
521	do jt = 1,10
522	iprsm = 0
523	do igc = 1,ngc(2)
524	sumk = 0.
525	do ipr = 1, ngn(ngs(1)+igc)
526	iprsm = iprsm + 1
527	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+16)
528	enddo
529	selfref(jt,igc) = sumk
530	enddo
531	enddo
532
533	do jt = 1,4
534	iprsm = 0
535	do igc = 1,ngc(2)
536	sumk = 0.
537	do ipr = 1, ngn(ngs(1)+igc)
538	iprsm = iprsm + 1
539	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+16)
540	enddo
541	forref(jt,igc) = sumk
542	enddo
543	enddo
544
545	iprsm = 0
546	do igc = 1,ngc(2)
547	sumf1 = 0.
548	sumf2 = 0.
549	do ipr = 1, ngn(ngs(1)+igc)
550	iprsm = iprsm + 1
551	sumf1= sumf1+ fracrefao(iprsm)
552	sumf2= sumf2+ fracrefbo(iprsm)
553	enddo
554	fracrefa(igc) = sumf1
555	fracrefb(igc) = sumf2
556	enddo
557
558	end subroutine cmbgb2
559
560	!***************************************************************************
561	subroutine cmbgb3
562	!***************************************************************************
563	!
564	! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o)
565	! (high key - h2o,co2; high minor - n2o)
566	!
567	! old band 3: 500-630 cm-1 (low - h2o,co2; high - h2o,co2)
568	!***************************************************************************
569
570	use parrrtm, only : mg, nbndlw, ngptlw, ng3
571	use rrlw_kg03, only: fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, &
572	selfrefo, forrefo, &
573	fracrefa, fracrefb, absa, ka, absb, kb, ka_mn2o, kb_mn2o, &
574	selfref, forref
575
576	! ------- Local -------
577	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
578	real(kind=rb) :: sumk, sumf
579
580
581	do jn = 1,9
582	do jt = 1,5
583	do jp = 1,13
584	iprsm = 0
585	do igc = 1,ngc(3)
586	sumk = 0.
587	do ipr = 1, ngn(ngs(2)+igc)
588	iprsm = iprsm + 1
589	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+32)
590	enddo
591	ka(jn,jt,jp,igc) = sumk
592	enddo
593	enddo
594	enddo
595	enddo
596	do jn = 1,5
597	do jt = 1,5
598	do jp = 13,59
599	iprsm = 0
600	do igc = 1,ngc(3)
601	sumk = 0.
602	do ipr = 1, ngn(ngs(2)+igc)
603	iprsm = iprsm + 1
604	sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+32)
605	enddo
606	kb(jn,jt,jp,igc) = sumk
607	enddo
608	enddo
609	enddo
610	enddo
611
612	do jn = 1,9
613	do jt = 1,19
614	iprsm = 0
615	do igc = 1,ngc(3)
616	sumk = 0.
617	do ipr = 1, ngn(ngs(2)+igc)
618	iprsm = iprsm + 1
619	sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+32)
620	enddo
621	ka_mn2o(jn,jt,igc) = sumk
622	enddo
623	enddo
624	enddo
625
626	do jn = 1,5
627	do jt = 1,19
628	iprsm = 0
629	do igc = 1,ngc(3)
630	sumk = 0.
631	do ipr = 1, ngn(ngs(2)+igc)
632	iprsm = iprsm + 1
633	sumk = sumk + kbo_mn2o(jn,jt,iprsm)*rwgt(iprsm+32)
634	enddo
635	kb_mn2o(jn,jt,igc) = sumk
636	enddo
637	enddo
638	enddo
639
640	do jt = 1,10
641	iprsm = 0
642	do igc = 1,ngc(3)
643	sumk = 0.
644	do ipr = 1, ngn(ngs(2)+igc)
645	iprsm = iprsm + 1
646	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+32)
647	enddo
648	selfref(jt,igc) = sumk
649	enddo
650	enddo
651
652	do jt = 1,4
653	iprsm = 0
654	do igc = 1,ngc(3)
655	sumk = 0.
656	do ipr = 1, ngn(ngs(2)+igc)
657	iprsm = iprsm + 1
658	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+32)
659	enddo
660	forref(jt,igc) = sumk
661	enddo
662	enddo
663
664	do jp = 1,9
665	iprsm = 0
666	do igc = 1,ngc(3)
667	sumf = 0.
668	do ipr = 1, ngn(ngs(2)+igc)
669	iprsm = iprsm + 1
670	sumf = sumf + fracrefao(iprsm,jp)
671	enddo
672	fracrefa(igc,jp) = sumf
673	enddo
674	enddo
675
676	do jp = 1,5
677	iprsm = 0
678	do igc = 1,ngc(3)
679	sumf = 0.
680	do ipr = 1, ngn(ngs(2)+igc)
681	iprsm = iprsm + 1
682	sumf = sumf + fracrefbo(iprsm,jp)
683	enddo
684	fracrefb(igc,jp) = sumf
685	enddo
686	enddo
687
688	end subroutine cmbgb3
689
690	!***************************************************************************
691	subroutine cmbgb4
692	!***************************************************************************
693	!
694	! band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2)
695	!
696	! old band 4: 630-700 cm-1 (low - h2o,co2; high - o3,co2)
697	!***************************************************************************
698
699	use parrrtm, only : mg, nbndlw, ngptlw, ng4
700	use rrlw_kg04, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
701	fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref
702
703	! ------- Local -------
704	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
705	real(kind=rb) :: sumk, sumf
706
707
708	do jn = 1,9
709	do jt = 1,5
710	do jp = 1,13
711	iprsm = 0
712	do igc = 1,ngc(4)
713	sumk = 0.
714	do ipr = 1, ngn(ngs(3)+igc)
715	iprsm = iprsm + 1
716	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+48)
717	enddo
718	ka(jn,jt,jp,igc) = sumk
719	enddo
720	enddo
721	enddo
722	enddo
723	do jn = 1,5
724	do jt = 1,5
725	do jp = 13,59
726	iprsm = 0
727	do igc = 1,ngc(4)
728	sumk = 0.
729	do ipr = 1, ngn(ngs(3)+igc)
730	iprsm = iprsm + 1
731	sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+48)
732	enddo
733	kb(jn,jt,jp,igc) = sumk
734	enddo
735	enddo
736	enddo
737	enddo
738
739	do jt = 1,10
740	iprsm = 0
741	do igc = 1,ngc(4)
742	sumk = 0.
743	do ipr = 1, ngn(ngs(3)+igc)
744	iprsm = iprsm + 1
745	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+48)
746	enddo
747	selfref(jt,igc) = sumk
748	enddo
749	enddo
750
751	do jt = 1,4
752	iprsm = 0
753	do igc = 1,ngc(4)
754	sumk = 0.
755	do ipr = 1, ngn(ngs(3)+igc)
756	iprsm = iprsm + 1
757	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+48)
758	enddo
759	forref(jt,igc) = sumk
760	enddo
761	enddo
762
763	do jp = 1,9
764	iprsm = 0
765	do igc = 1,ngc(4)
766	sumf = 0.
767	do ipr = 1, ngn(ngs(3)+igc)
768	iprsm = iprsm + 1
769	sumf = sumf + fracrefao(iprsm,jp)
770	enddo
771	fracrefa(igc,jp) = sumf
772	enddo
773	enddo
774
775	do jp = 1,5
776	iprsm = 0
777	do igc = 1,ngc(4)
778	sumf = 0.
779	do ipr = 1, ngn(ngs(3)+igc)
780	iprsm = iprsm + 1
781	sumf = sumf + fracrefbo(iprsm,jp)
782	enddo
783	fracrefb(igc,jp) = sumf
784	enddo
785	enddo
786
787	end subroutine cmbgb4
788
789	!***************************************************************************
790	subroutine cmbgb5
791	!***************************************************************************
792	!
793	! band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
794	! (high key - o3,co2)
795	!
796	! old band 5: 700-820 cm-1 (low - h2o,co2; high - o3,co2)
797	!***************************************************************************
798
799	use parrrtm, only : mg, nbndlw, ngptlw, ng5
800	use rrlw_kg05, only: fracrefao, fracrefbo, kao, kbo, kao_mo3, ccl4o, &
801	selfrefo, forrefo, &
802	fracrefa, fracrefb, absa, ka, absb, kb, ka_mo3, ccl4, &
803	selfref, forref
804
805	! ------- Local -------
806	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
807	real(kind=rb) :: sumk, sumf
808
809
810	do jn = 1,9
811	do jt = 1,5
812	do jp = 1,13
813	iprsm = 0
814	do igc = 1,ngc(5)
815	sumk = 0.
816	do ipr = 1, ngn(ngs(4)+igc)
817	iprsm = iprsm + 1
818	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+64)
819	enddo
820	ka(jn,jt,jp,igc) = sumk
821	enddo
822	enddo
823	enddo
824	enddo
825	do jn = 1,5
826	do jt = 1,5
827	do jp = 13,59
828	iprsm = 0
829	do igc = 1,ngc(5)
830	sumk = 0.
831	do ipr = 1, ngn(ngs(4)+igc)
832	iprsm = iprsm + 1
833	sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+64)
834	enddo
835	kb(jn,jt,jp,igc) = sumk
836	enddo
837	enddo
838	enddo
839	enddo
840
841	do jn = 1,9
842	do jt = 1,19
843	iprsm = 0
844	do igc = 1,ngc(5)
845	sumk = 0.
846	do ipr = 1, ngn(ngs(4)+igc)
847	iprsm = iprsm + 1
848	sumk = sumk + kao_mo3(jn,jt,iprsm)*rwgt(iprsm+64)
849	enddo
850	ka_mo3(jn,jt,igc) = sumk
851	enddo
852	enddo
853	enddo
854
855	do jt = 1,10
856	iprsm = 0
857	do igc = 1,ngc(5)
858	sumk = 0.
859	do ipr = 1, ngn(ngs(4)+igc)
860	iprsm = iprsm + 1
861	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+64)
862	enddo
863	selfref(jt,igc) = sumk
864	enddo
865	enddo
866
867	do jt = 1,4
868	iprsm = 0
869	do igc = 1,ngc(5)
870	sumk = 0.
871	do ipr = 1, ngn(ngs(4)+igc)
872	iprsm = iprsm + 1
873	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+64)
874	enddo
875	forref(jt,igc) = sumk
876	enddo
877	enddo
878
879	do jp = 1,9
880	iprsm = 0
881	do igc = 1,ngc(5)
882	sumf = 0.
883	do ipr = 1, ngn(ngs(4)+igc)
884	iprsm = iprsm + 1
885	sumf = sumf + fracrefao(iprsm,jp)
886	enddo
887	fracrefa(igc,jp) = sumf
888	enddo
889	enddo
890
891	do jp = 1,5
892	iprsm = 0
893	do igc = 1,ngc(5)
894	sumf = 0.
895	do ipr = 1, ngn(ngs(4)+igc)
896	iprsm = iprsm + 1
897	sumf = sumf + fracrefbo(iprsm,jp)
898	enddo
899	fracrefb(igc,jp) = sumf
900	enddo
901	enddo
902
903	iprsm = 0
904	do igc = 1,ngc(5)
905	sumk = 0.
906	do ipr = 1, ngn(ngs(4)+igc)
907	iprsm = iprsm + 1
908	sumk = sumk + ccl4o(iprsm)*rwgt(iprsm+64)
909	enddo
910	ccl4(igc) = sumk
911	enddo
912
913	end subroutine cmbgb5
914
915	!***************************************************************************
916	subroutine cmbgb6
917	!***************************************************************************
918	!
919	! band 6: 820-980 cm-1 (low key - h2o; low minor - co2)
920	! (high key - nothing; high minor - cfc11, cfc12)
921	!
922	! old band 6: 820-980 cm-1 (low - h2o; high - nothing)
923	!***************************************************************************
924
925	use parrrtm, only : mg, nbndlw, ngptlw, ng6
926	use rrlw_kg06, only: fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, &
927	selfrefo, forrefo, &
928	fracrefa, absa, ka, ka_mco2, cfc11adj, cfc12, &
929	selfref, forref
930
931	! ------- Local -------
932	integer(kind=im) :: jt, jp, igc, ipr, iprsm
933	real(kind=rb) :: sumk, sumf, sumk1, sumk2
934
935
936	do jt = 1,5
937	do jp = 1,13
938	iprsm = 0
939	do igc = 1,ngc(6)
940	sumk = 0.
941	do ipr = 1, ngn(ngs(5)+igc)
942	iprsm = iprsm + 1
943	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+80)
944	enddo
945	ka(jt,jp,igc) = sumk
946	enddo
947	enddo
948	enddo
949
950	do jt = 1,19
951	iprsm = 0
952	do igc = 1,ngc(6)
953	sumk = 0.
954	do ipr = 1, ngn(ngs(5)+igc)
955	iprsm = iprsm + 1
956	sumk = sumk + kao_mco2(jt,iprsm)*rwgt(iprsm+80)
957	enddo
958	ka_mco2(jt,igc) = sumk
959	enddo
960	enddo
961
962	do jt = 1,10
963	iprsm = 0
964	do igc = 1,ngc(6)
965	sumk = 0.
966	do ipr = 1, ngn(ngs(5)+igc)
967	iprsm = iprsm + 1
968	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+80)
969	enddo
970	selfref(jt,igc) = sumk
971	enddo
972	enddo
973
974	do jt = 1,4
975	iprsm = 0
976	do igc = 1,ngc(6)
977	sumk = 0.
978	do ipr = 1, ngn(ngs(5)+igc)
979	iprsm = iprsm + 1
980	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+80)
981	enddo
982	forref(jt,igc) = sumk
983	enddo
984	enddo
985
986	iprsm = 0
987	do igc = 1,ngc(6)
988	sumf = 0.
989	sumk1= 0.
990	sumk2= 0.
991	do ipr = 1, ngn(ngs(5)+igc)
992	iprsm = iprsm + 1
993	sumf = sumf + fracrefao(iprsm)
994	sumk1= sumk1+ cfc11adjo(iprsm)*rwgt(iprsm+80)
995	sumk2= sumk2+ cfc12o(iprsm)*rwgt(iprsm+80)
996	enddo
997	fracrefa(igc) = sumf
998	cfc11adj(igc) = sumk1
999	cfc12(igc) = sumk2
1000	enddo
1001
1002	end subroutine cmbgb6
1003
1004	!***************************************************************************
1005	subroutine cmbgb7
1006	!***************************************************************************
1007	!
1008	! band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2)
1009	! (high key - o3; high minor - co2)
1010	!
1011	! old band 7: 980-1080 cm-1 (low - h2o,o3; high - o3)
1012	!***************************************************************************
1013
1014	use parrrtm, only : mg, nbndlw, ngptlw, ng7
1015	use rrlw_kg07, only: fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, &
1016	selfrefo, forrefo, &
1017	fracrefa, fracrefb, absa, ka, absb, kb, ka_mco2, kb_mco2, &
1018	selfref, forref
1019
1020	! ------- Local -------
1021	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
1022	real(kind=rb) :: sumk, sumf
1023
1024
1025	do jn = 1,9
1026	do jt = 1,5
1027	do jp = 1,13
1028	iprsm = 0
1029	do igc = 1,ngc(7)
1030	sumk = 0.
1031	do ipr = 1, ngn(ngs(6)+igc)
1032	iprsm = iprsm + 1
1033	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+96)
1034	enddo
1035	ka(jn,jt,jp,igc) = sumk
1036	enddo
1037	enddo
1038	enddo
1039	enddo
1040	do jt = 1,5
1041	do jp = 13,59
1042	iprsm = 0
1043	do igc = 1,ngc(7)
1044	sumk = 0.
1045	do ipr = 1, ngn(ngs(6)+igc)
1046	iprsm = iprsm + 1
1047	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+96)
1048	enddo
1049	kb(jt,jp,igc) = sumk
1050	enddo
1051	enddo
1052	enddo
1053
1054	do jn = 1,9
1055	do jt = 1,19
1056	iprsm = 0
1057	do igc = 1,ngc(7)
1058	sumk = 0.
1059	do ipr = 1, ngn(ngs(6)+igc)
1060	iprsm = iprsm + 1
1061	sumk = sumk + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+96)
1062	enddo
1063	ka_mco2(jn,jt,igc) = sumk
1064	enddo
1065	enddo
1066	enddo
1067
1068	do jt = 1,19
1069	iprsm = 0
1070	do igc = 1,ngc(7)
1071	sumk = 0.
1072	do ipr = 1, ngn(ngs(6)+igc)
1073	iprsm = iprsm + 1
1074	sumk = sumk + kbo_mco2(jt,iprsm)*rwgt(iprsm+96)
1075	enddo
1076	kb_mco2(jt,igc) = sumk
1077	enddo
1078	enddo
1079
1080	do jt = 1,10
1081	iprsm = 0
1082	do igc = 1,ngc(7)
1083	sumk = 0.
1084	do ipr = 1, ngn(ngs(6)+igc)
1085	iprsm = iprsm + 1
1086	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+96)
1087	enddo
1088	selfref(jt,igc) = sumk
1089	enddo
1090	enddo
1091
1092	do jt = 1,4
1093	iprsm = 0
1094	do igc = 1,ngc(7)
1095	sumk = 0.
1096	do ipr = 1, ngn(ngs(6)+igc)
1097	iprsm = iprsm + 1
1098	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+96)
1099	enddo
1100	forref(jt,igc) = sumk
1101	enddo
1102	enddo
1103
1104	do jp = 1,9
1105	iprsm = 0
1106	do igc = 1,ngc(7)
1107	sumf = 0.
1108	do ipr = 1, ngn(ngs(6)+igc)
1109	iprsm = iprsm + 1
1110	sumf = sumf + fracrefao(iprsm,jp)
1111	enddo
1112	fracrefa(igc,jp) = sumf
1113	enddo
1114	enddo
1115
1116	iprsm = 0
1117	do igc = 1,ngc(7)
1118	sumf = 0.
1119	do ipr = 1, ngn(ngs(6)+igc)
1120	iprsm = iprsm + 1
1121	sumf = sumf + fracrefbo(iprsm)
1122	enddo
1123	fracrefb(igc) = sumf
1124	enddo
1125
1126	end subroutine cmbgb7
1127
1128	!***************************************************************************
1129	subroutine cmbgb8
1130	!***************************************************************************
1131	!
1132	! band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
1133	! (high key - o3; high minor - co2, n2o)
1134	!
1135	! old band 8: 1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
1136	!***************************************************************************
1137
1138	use parrrtm, only : mg, nbndlw, ngptlw, ng8
1139	use rrlw_kg08, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, &
1140	kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, &
1141	cfc12o, cfc22adjo, &
1142	fracrefa, fracrefb, absa, ka, ka_mco2, ka_mn2o, &
1143	ka_mo3, absb, kb, kb_mco2, kb_mn2o, selfref, forref, &
1144	cfc12, cfc22adj
1145
1146	! ------- Local -------
1147	integer(kind=im) :: jt, jp, igc, ipr, iprsm
1148	real(kind=rb) :: sumk, sumk1, sumk2, sumk3, sumk4, sumk5, sumf1, sumf2
1149
1150
1151	do jt = 1,5
1152	do jp = 1,13
1153	iprsm = 0
1154	do igc = 1,ngc(8)
1155	sumk = 0.
1156	do ipr = 1, ngn(ngs(7)+igc)
1157	iprsm = iprsm + 1
1158	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+112)
1159	enddo
1160	ka(jt,jp,igc) = sumk
1161	enddo
1162	enddo
1163	enddo
1164	do jt = 1,5
1165	do jp = 13,59
1166	iprsm = 0
1167	do igc = 1,ngc(8)
1168	sumk = 0.
1169	do ipr = 1, ngn(ngs(7)+igc)
1170	iprsm = iprsm + 1
1171	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+112)
1172	enddo
1173	kb(jt,jp,igc) = sumk
1174	enddo
1175	enddo
1176	enddo
1177
1178	do jt = 1,10
1179	iprsm = 0
1180	do igc = 1,ngc(8)
1181	sumk = 0.
1182	do ipr = 1, ngn(ngs(7)+igc)
1183	iprsm = iprsm + 1
1184	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+112)
1185	enddo
1186	selfref(jt,igc) = sumk
1187	enddo
1188	enddo
1189
1190	do jt = 1,4
1191	iprsm = 0
1192	do igc = 1,ngc(8)
1193	sumk = 0.
1194	do ipr = 1, ngn(ngs(7)+igc)
1195	iprsm = iprsm + 1
1196	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+112)
1197	enddo
1198	forref(jt,igc) = sumk
1199	enddo
1200	enddo
1201
1202	do jt = 1,19
1203	iprsm = 0
1204	do igc = 1,ngc(8)
1205	sumk1 = 0.
1206	sumk2 = 0.
1207	sumk3 = 0.
1208	sumk4 = 0.
1209	sumk5 = 0.
1210	do ipr = 1, ngn(ngs(7)+igc)
1211	iprsm = iprsm + 1
1212	sumk1 = sumk1 + kao_mco2(jt,iprsm)*rwgt(iprsm+112)
1213	sumk2 = sumk2 + kbo_mco2(jt,iprsm)*rwgt(iprsm+112)
1214	sumk3 = sumk3 + kao_mo3(jt,iprsm)*rwgt(iprsm+112)
1215	sumk4 = sumk4 + kao_mn2o(jt,iprsm)*rwgt(iprsm+112)
1216	sumk5 = sumk5 + kbo_mn2o(jt,iprsm)*rwgt(iprsm+112)
1217	enddo
1218	ka_mco2(jt,igc) = sumk1
1219	kb_mco2(jt,igc) = sumk2
1220	ka_mo3(jt,igc) = sumk3
1221	ka_mn2o(jt,igc) = sumk4
1222	kb_mn2o(jt,igc) = sumk5
1223	enddo
1224	enddo
1225
1226	iprsm = 0
1227	do igc = 1,ngc(8)
1228	sumf1= 0.
1229	sumf2= 0.
1230	sumk1= 0.
1231	sumk2= 0.
1232	do ipr = 1, ngn(ngs(7)+igc)
1233	iprsm = iprsm + 1
1234	sumf1= sumf1+ fracrefao(iprsm)
1235	sumf2= sumf2+ fracrefbo(iprsm)
1236	sumk1= sumk1+ cfc12o(iprsm)*rwgt(iprsm+112)
1237	sumk2= sumk2+ cfc22adjo(iprsm)*rwgt(iprsm+112)
1238	enddo
1239	fracrefa(igc) = sumf1
1240	fracrefb(igc) = sumf2
1241	cfc12(igc) = sumk1
1242	cfc22adj(igc) = sumk2
1243	enddo
1244
1245	end subroutine cmbgb8
1246
1247	!***************************************************************************
1248	subroutine cmbgb9
1249	!***************************************************************************
1250	!
1251	! band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
1252	! (high key - ch4; high minor - n2o)!
1253
1254	! old band 9: 1180-1390 cm-1 (low - h2o,ch4; high - ch4)
1255	!***************************************************************************
1256
1257	use parrrtm, only : mg, nbndlw, ngptlw, ng9
1258	use rrlw_kg09, only: fracrefao, fracrefbo, kao, kao_mn2o, &
1259	kbo, kbo_mn2o, selfrefo, forrefo, &
1260	fracrefa, fracrefb, absa, ka, ka_mn2o, &
1261	absb, kb, kb_mn2o, selfref, forref
1262
1263	! ------- Local -------
1264	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
1265	real(kind=rb) :: sumk, sumf
1266
1267
1268	do jn = 1,9
1269	do jt = 1,5
1270	do jp = 1,13
1271	iprsm = 0
1272	do igc = 1,ngc(9)
1273	sumk = 0.
1274	do ipr = 1, ngn(ngs(8)+igc)
1275	iprsm = iprsm + 1
1276	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+128)
1277	enddo
1278	ka(jn,jt,jp,igc) = sumk
1279	enddo
1280	enddo
1281	enddo
1282	enddo
1283
1284	do jt = 1,5
1285	do jp = 13,59
1286	iprsm = 0
1287	do igc = 1,ngc(9)
1288	sumk = 0.
1289	do ipr = 1, ngn(ngs(8)+igc)
1290	iprsm = iprsm + 1
1291	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+128)
1292	enddo
1293	kb(jt,jp,igc) = sumk
1294	enddo
1295	enddo
1296	enddo
1297
1298	do jn = 1,9
1299	do jt = 1,19
1300	iprsm = 0
1301	do igc = 1,ngc(9)
1302	sumk = 0.
1303	do ipr = 1, ngn(ngs(8)+igc)
1304	iprsm = iprsm + 1
1305	sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+128)
1306	enddo
1307	ka_mn2o(jn,jt,igc) = sumk
1308	enddo
1309	enddo
1310	enddo
1311
1312	do jt = 1,19
1313	iprsm = 0
1314	do igc = 1,ngc(9)
1315	sumk = 0.
1316	do ipr = 1, ngn(ngs(8)+igc)
1317	iprsm = iprsm + 1
1318	sumk = sumk + kbo_mn2o(jt,iprsm)*rwgt(iprsm+128)
1319	enddo
1320	kb_mn2o(jt,igc) = sumk
1321	enddo
1322	enddo
1323
1324	do jt = 1,10
1325	iprsm = 0
1326	do igc = 1,ngc(9)
1327	sumk = 0.
1328	do ipr = 1, ngn(ngs(8)+igc)
1329	iprsm = iprsm + 1
1330	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+128)
1331	enddo
1332	selfref(jt,igc) = sumk
1333	enddo
1334	enddo
1335
1336	do jt = 1,4
1337	iprsm = 0
1338	do igc = 1,ngc(9)
1339	sumk = 0.
1340	do ipr = 1, ngn(ngs(8)+igc)
1341	iprsm = iprsm + 1
1342	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+128)
1343	enddo
1344	forref(jt,igc) = sumk
1345	enddo
1346	enddo
1347
1348	do jp = 1,9
1349	iprsm = 0
1350	do igc = 1,ngc(9)
1351	sumf = 0.
1352	do ipr = 1, ngn(ngs(8)+igc)
1353	iprsm = iprsm + 1
1354	sumf = sumf + fracrefao(iprsm,jp)
1355	enddo
1356	fracrefa(igc,jp) = sumf
1357	enddo
1358	enddo
1359
1360	iprsm = 0
1361	do igc = 1,ngc(9)
1362	sumf = 0.
1363	do ipr = 1, ngn(ngs(8)+igc)
1364	iprsm = iprsm + 1
1365	sumf = sumf + fracrefbo(iprsm)
1366	enddo
1367	fracrefb(igc) = sumf
1368	enddo
1369
1370	end subroutine cmbgb9
1371
1372	!***************************************************************************
1373	subroutine cmbgb10
1374	!***************************************************************************
1375	!
1376	! band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o)
1377	!
1378	! old band 10: 1390-1480 cm-1 (low - h2o; high - h2o)
1379	!***************************************************************************
1380
1381	use parrrtm, only : mg, nbndlw, ngptlw, ng10
1382	use rrlw_kg10, only: fracrefao, fracrefbo, kao, kbo, &
1383	selfrefo, forrefo, &
1384	fracrefa, fracrefb, absa, ka, absb, kb, &
1385	selfref, forref
1386
1387	! ------- Local -------
1388	integer(kind=im) :: jt, jp, igc, ipr, iprsm
1389	real(kind=rb) :: sumk, sumf1, sumf2
1390
1391
1392	do jt = 1,5
1393	do jp = 1,13
1394	iprsm = 0
1395	do igc = 1,ngc(10)
1396	sumk = 0.
1397	do ipr = 1, ngn(ngs(9)+igc)
1398	iprsm = iprsm + 1
1399	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+144)
1400	enddo
1401	ka(jt,jp,igc) = sumk
1402	enddo
1403	enddo
1404	enddo
1405
1406	do jt = 1,5
1407	do jp = 13,59
1408	iprsm = 0
1409	do igc = 1,ngc(10)
1410	sumk = 0.
1411	do ipr = 1, ngn(ngs(9)+igc)
1412	iprsm = iprsm + 1
1413	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+144)
1414	enddo
1415	kb(jt,jp,igc) = sumk
1416	enddo
1417	enddo
1418	enddo
1419
1420	do jt = 1,10
1421	iprsm = 0
1422	do igc = 1,ngc(10)
1423	sumk = 0.
1424	do ipr = 1, ngn(ngs(9)+igc)
1425	iprsm = iprsm + 1
1426	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+144)
1427	enddo
1428	selfref(jt,igc) = sumk
1429	enddo
1430	enddo
1431
1432	do jt = 1,4
1433	iprsm = 0
1434	do igc = 1,ngc(10)
1435	sumk = 0.
1436	do ipr = 1, ngn(ngs(9)+igc)
1437	iprsm = iprsm + 1
1438	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+144)
1439	enddo
1440	forref(jt,igc) = sumk
1441	enddo
1442	enddo
1443
1444	iprsm = 0
1445	do igc = 1,ngc(10)
1446	sumf1= 0.
1447	sumf2= 0.
1448	do ipr = 1, ngn(ngs(9)+igc)
1449	iprsm = iprsm + 1
1450	sumf1= sumf1+ fracrefao(iprsm)
1451	sumf2= sumf2+ fracrefbo(iprsm)
1452	enddo
1453	fracrefa(igc) = sumf1
1454	fracrefb(igc) = sumf2
1455	enddo
1456
1457	end subroutine cmbgb10
1458
1459	!***************************************************************************
1460	subroutine cmbgb11
1461	!***************************************************************************
1462	!
1463	! band 11: 1480-1800 cm-1 (low - h2o; low minor - o2)
1464	! (high key - h2o; high minor - o2)
1465	!
1466	! old band 11: 1480-1800 cm-1 (low - h2o; low minor - o2)
1467	! (high key - h2o; high minor - o2)
1468	!***************************************************************************
1469
1470	use parrrtm, only : mg, nbndlw, ngptlw, ng11
1471	use rrlw_kg11, only: fracrefao, fracrefbo, kao, kao_mo2, &
1472	kbo, kbo_mo2, selfrefo, forrefo, &
1473	fracrefa, fracrefb, absa, ka, ka_mo2, &
1474	absb, kb, kb_mo2, selfref, forref
1475
1476	! ------- Local -------
1477	integer(kind=im) :: jt, jp, igc, ipr, iprsm
1478	real(kind=rb) :: sumk, sumk1, sumk2, sumf1, sumf2
1479
1480
1481	do jt = 1,5
1482	do jp = 1,13
1483	iprsm = 0
1484	do igc = 1,ngc(11)
1485	sumk = 0.
1486	do ipr = 1, ngn(ngs(10)+igc)
1487	iprsm = iprsm + 1
1488	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+160)
1489	enddo
1490	ka(jt,jp,igc) = sumk
1491	enddo
1492	enddo
1493	enddo
1494	do jt = 1,5
1495	do jp = 13,59
1496	iprsm = 0
1497	do igc = 1,ngc(11)
1498	sumk = 0.
1499	do ipr = 1, ngn(ngs(10)+igc)
1500	iprsm = iprsm + 1
1501	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+160)
1502	enddo
1503	kb(jt,jp,igc) = sumk
1504	enddo
1505	enddo
1506	enddo
1507
1508	do jt = 1,19
1509	iprsm = 0
1510	do igc = 1,ngc(11)
1511	sumk1 = 0.
1512	sumk2 = 0.
1513	do ipr = 1, ngn(ngs(10)+igc)
1514	iprsm = iprsm + 1
1515	sumk1 = sumk1 + kao_mo2(jt,iprsm)*rwgt(iprsm+160)
1516	sumk2 = sumk2 + kbo_mo2(jt,iprsm)*rwgt(iprsm+160)
1517	enddo
1518	ka_mo2(jt,igc) = sumk1
1519	kb_mo2(jt,igc) = sumk2
1520	enddo
1521	enddo
1522
1523	do jt = 1,10
1524	iprsm = 0
1525	do igc = 1,ngc(11)
1526	sumk = 0.
1527	do ipr = 1, ngn(ngs(10)+igc)
1528	iprsm = iprsm + 1
1529	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+160)
1530	enddo
1531	selfref(jt,igc) = sumk
1532	enddo
1533	enddo
1534
1535	do jt = 1,4
1536	iprsm = 0
1537	do igc = 1,ngc(11)
1538	sumk = 0.
1539	do ipr = 1, ngn(ngs(10)+igc)
1540	iprsm = iprsm + 1
1541	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+160)
1542	enddo
1543	forref(jt,igc) = sumk
1544	enddo
1545	enddo
1546
1547	iprsm = 0
1548	do igc = 1,ngc(11)
1549	sumf1= 0.
1550	sumf2= 0.
1551	do ipr = 1, ngn(ngs(10)+igc)
1552	iprsm = iprsm + 1
1553	sumf1= sumf1+ fracrefao(iprsm)
1554	sumf2= sumf2+ fracrefbo(iprsm)
1555	enddo
1556	fracrefa(igc) = sumf1
1557	fracrefb(igc) = sumf2
1558	enddo
1559
1560	end subroutine cmbgb11
1561
1562	!***************************************************************************
1563	subroutine cmbgb12
1564	!***************************************************************************
1565	!
1566	! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing)
1567	!
1568	! old band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing)
1569	!***************************************************************************
1570
1571	use parrrtm, only : mg, nbndlw, ngptlw, ng12
1572	use rrlw_kg12, only: fracrefao, kao, selfrefo, forrefo, &
1573	fracrefa, absa, ka, selfref, forref
1574
1575	! ------- Local -------
1576	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
1577	real(kind=rb) :: sumk, sumf
1578
1579
1580	do jn = 1,9
1581	do jt = 1,5
1582	do jp = 1,13
1583	iprsm = 0
1584	do igc = 1,ngc(12)
1585	sumk = 0.
1586	do ipr = 1, ngn(ngs(11)+igc)
1587	iprsm = iprsm + 1
1588	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+176)
1589	enddo
1590	ka(jn,jt,jp,igc) = sumk
1591	enddo
1592	enddo
1593	enddo
1594	enddo
1595
1596	do jt = 1,10
1597	iprsm = 0
1598	do igc = 1,ngc(12)
1599	sumk = 0.
1600	do ipr = 1, ngn(ngs(11)+igc)
1601	iprsm = iprsm + 1
1602	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+176)
1603	enddo
1604	selfref(jt,igc) = sumk
1605	enddo
1606	enddo
1607
1608	do jt = 1,4
1609	iprsm = 0
1610	do igc = 1,ngc(12)
1611	sumk = 0.
1612	do ipr = 1, ngn(ngs(11)+igc)
1613	iprsm = iprsm + 1
1614	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+176)
1615	enddo
1616	forref(jt,igc) = sumk
1617	enddo
1618	enddo
1619
1620	do jp = 1,9
1621	iprsm = 0
1622	do igc = 1,ngc(12)
1623	sumf = 0.
1624	do ipr = 1, ngn(ngs(11)+igc)
1625	iprsm = iprsm + 1
1626	sumf = sumf + fracrefao(iprsm,jp)
1627	enddo
1628	fracrefa(igc,jp) = sumf
1629	enddo
1630	enddo
1631
1632	end subroutine cmbgb12
1633
1634	!***************************************************************************
1635	subroutine cmbgb13
1636	!***************************************************************************
1637	!
1638	! band 13: 2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
1639	!
1640	! old band 13: 2080-2250 cm-1 (low - h2o,n2o; high - nothing)
1641	!***************************************************************************
1642
1643	use parrrtm, only : mg, nbndlw, ngptlw, ng13
1644	use rrlw_kg13, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mco, &
1645	kbo_mo3, selfrefo, forrefo, &
1646	fracrefa, fracrefb, absa, ka, ka_mco2, ka_mco, &
1647	kb_mo3, selfref, forref
1648
1649	! ------- Local -------
1650	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
1651	real(kind=rb) :: sumk, sumk1, sumk2, sumf
1652
1653
1654	do jn = 1,9
1655	do jt = 1,5
1656	do jp = 1,13
1657	iprsm = 0
1658	do igc = 1,ngc(13)
1659	sumk = 0.
1660	do ipr = 1, ngn(ngs(12)+igc)
1661	iprsm = iprsm + 1
1662	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+192)
1663	enddo
1664	ka(jn,jt,jp,igc) = sumk
1665	enddo
1666	enddo
1667	enddo
1668	enddo
1669
1670	do jn = 1,9
1671	do jt = 1,19
1672	iprsm = 0
1673	do igc = 1,ngc(13)
1674	sumk1 = 0.
1675	sumk2 = 0.
1676	do ipr = 1, ngn(ngs(12)+igc)
1677	iprsm = iprsm + 1
1678	sumk1 = sumk1 + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+192)
1679	sumk2 = sumk2 + kao_mco(jn,jt,iprsm)*rwgt(iprsm+192)
1680	enddo
1681	ka_mco2(jn,jt,igc) = sumk1
1682	ka_mco(jn,jt,igc) = sumk2
1683	enddo
1684	enddo
1685	enddo
1686
1687	do jt = 1,19
1688	iprsm = 0
1689	do igc = 1,ngc(13)
1690	sumk = 0.
1691	do ipr = 1, ngn(ngs(12)+igc)
1692	iprsm = iprsm + 1
1693	sumk = sumk + kbo_mo3(jt,iprsm)*rwgt(iprsm+192)
1694	enddo
1695	kb_mo3(jt,igc) = sumk
1696	enddo
1697	enddo
1698
1699	do jt = 1,10
1700	iprsm = 0
1701	do igc = 1,ngc(13)
1702	sumk = 0.
1703	do ipr = 1, ngn(ngs(12)+igc)
1704	iprsm = iprsm + 1
1705	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+192)
1706	enddo
1707	selfref(jt,igc) = sumk
1708	enddo
1709	enddo
1710
1711	do jt = 1,4
1712	iprsm = 0
1713	do igc = 1,ngc(13)
1714	sumk = 0.
1715	do ipr = 1, ngn(ngs(12)+igc)
1716	iprsm = iprsm + 1
1717	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+192)
1718	enddo
1719	forref(jt,igc) = sumk
1720	enddo
1721	enddo
1722
1723	iprsm = 0
1724	do igc = 1,ngc(13)
1725	sumf = 0.
1726	do ipr = 1, ngn(ngs(12)+igc)
1727	iprsm = iprsm + 1
1728	sumf = sumf + fracrefbo(iprsm)
1729	enddo
1730	fracrefb(igc) = sumf
1731	enddo
1732
1733	do jp = 1,9
1734	iprsm = 0
1735	do igc = 1,ngc(13)
1736	sumf = 0.
1737	do ipr = 1, ngn(ngs(12)+igc)
1738	iprsm = iprsm + 1
1739	sumf = sumf + fracrefao(iprsm,jp)
1740	enddo
1741	fracrefa(igc,jp) = sumf
1742	enddo
1743	enddo
1744
1745	end subroutine cmbgb13
1746
1747	!***************************************************************************
1748	subroutine cmbgb14
1749	!***************************************************************************
1750	!
1751	! band 14: 2250-2380 cm-1 (low - co2; high - co2)
1752	!
1753	! old band 14: 2250-2380 cm-1 (low - co2; high - co2)
1754	!***************************************************************************
1755
1756	use parrrtm, only : mg, nbndlw, ngptlw, ng14
1757	use rrlw_kg14, only: fracrefao, fracrefbo, kao, kbo, &
1758	selfrefo, forrefo, &
1759	fracrefa, fracrefb, absa, ka, absb, kb, &
1760	selfref, forref
1761
1762	! ------- Local -------
1763	integer(kind=im) :: jt, jp, igc, ipr, iprsm
1764	real(kind=rb) :: sumk, sumf1, sumf2
1765
1766
1767	do jt = 1,5
1768	do jp = 1,13
1769	iprsm = 0
1770	do igc = 1,ngc(14)
1771	sumk = 0.
1772	do ipr = 1, ngn(ngs(13)+igc)
1773	iprsm = iprsm + 1
1774	sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+208)
1775	enddo
1776	ka(jt,jp,igc) = sumk
1777	enddo
1778	enddo
1779	enddo
1780
1781	do jt = 1,5
1782	do jp = 13,59
1783	iprsm = 0
1784	do igc = 1,ngc(14)
1785	sumk = 0.
1786	do ipr = 1, ngn(ngs(13)+igc)
1787	iprsm = iprsm + 1
1788	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+208)
1789	enddo
1790	kb(jt,jp,igc) = sumk
1791	enddo
1792	enddo
1793	enddo
1794
1795	do jt = 1,10
1796	iprsm = 0
1797	do igc = 1,ngc(14)
1798	sumk = 0.
1799	do ipr = 1, ngn(ngs(13)+igc)
1800	iprsm = iprsm + 1
1801	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+208)
1802	enddo
1803	selfref(jt,igc) = sumk
1804	enddo
1805	enddo
1806
1807	do jt = 1,4
1808	iprsm = 0
1809	do igc = 1,ngc(14)
1810	sumk = 0.
1811	do ipr = 1, ngn(ngs(13)+igc)
1812	iprsm = iprsm + 1
1813	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+208)
1814	enddo
1815	forref(jt,igc) = sumk
1816	enddo
1817	enddo
1818
1819	iprsm = 0
1820	do igc = 1,ngc(14)
1821	sumf1= 0.
1822	sumf2= 0.
1823	do ipr = 1, ngn(ngs(13)+igc)
1824	iprsm = iprsm + 1
1825	sumf1= sumf1+ fracrefao(iprsm)
1826	sumf2= sumf2+ fracrefbo(iprsm)
1827	enddo
1828	fracrefa(igc) = sumf1
1829	fracrefb(igc) = sumf2
1830	enddo
1831
1832	end subroutine cmbgb14
1833
1834	!***************************************************************************
1835	subroutine cmbgb15
1836	!***************************************************************************
1837	!
1838	! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2)
1839	! (high - nothing)
1840	!
1841	! old band 15: 2380-2600 cm-1 (low - n2o,co2; high - nothing)
1842	!***************************************************************************
1843
1844	use parrrtm, only : mg, nbndlw, ngptlw, ng15
1845	use rrlw_kg15, only: fracrefao, kao, kao_mn2, selfrefo, forrefo, &
1846	fracrefa, absa, ka, ka_mn2, selfref, forref
1847
1848	! ------- Local -------
1849	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
1850	real(kind=rb) :: sumk, sumf
1851
1852
1853	do jn = 1,9
1854	do jt = 1,5
1855	do jp = 1,13
1856	iprsm = 0
1857	do igc = 1,ngc(15)
1858	sumk = 0.
1859	do ipr = 1, ngn(ngs(14)+igc)
1860	iprsm = iprsm + 1
1861	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+224)
1862	enddo
1863	ka(jn,jt,jp,igc) = sumk
1864	enddo
1865	enddo
1866	enddo
1867	enddo
1868
1869	do jn = 1,9
1870	do jt = 1,19
1871	iprsm = 0
1872	do igc = 1,ngc(15)
1873	sumk = 0.
1874	do ipr = 1, ngn(ngs(14)+igc)
1875	iprsm = iprsm + 1
1876	sumk = sumk + kao_mn2(jn,jt,iprsm)*rwgt(iprsm+224)
1877	enddo
1878	ka_mn2(jn,jt,igc) = sumk
1879	enddo
1880	enddo
1881	enddo
1882
1883	do jt = 1,10
1884	iprsm = 0
1885	do igc = 1,ngc(15)
1886	sumk = 0.
1887	do ipr = 1, ngn(ngs(14)+igc)
1888	iprsm = iprsm + 1
1889	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+224)
1890	enddo
1891	selfref(jt,igc) = sumk
1892	enddo
1893	enddo
1894
1895	do jt = 1,4
1896	iprsm = 0
1897	do igc = 1,ngc(15)
1898	sumk = 0.
1899	do ipr = 1, ngn(ngs(14)+igc)
1900	iprsm = iprsm + 1
1901	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+224)
1902	enddo
1903	forref(jt,igc) = sumk
1904	enddo
1905	enddo
1906
1907	do jp = 1,9
1908	iprsm = 0
1909	do igc = 1,ngc(15)
1910	sumf = 0.
1911	do ipr = 1, ngn(ngs(14)+igc)
1912	iprsm = iprsm + 1
1913	sumf = sumf + fracrefao(iprsm,jp)
1914	enddo
1915	fracrefa(igc,jp) = sumf
1916	enddo
1917	enddo
1918
1919	end subroutine cmbgb15
1920
1921	!***************************************************************************
1922	subroutine cmbgb16
1923	!***************************************************************************
1924	!
1925	! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
1926	!
1927	! old band 16: 2600-3000 cm-1 (low - h2o,ch4; high - nothing)
1928	!***************************************************************************
1929
1930	use parrrtm, only : mg, nbndlw, ngptlw, ng16
1931	use rrlw_kg16, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
1932	fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref
1933
1934	! ------- Local -------
1935	integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
1936	real(kind=rb) :: sumk, sumf
1937
1938
1939	do jn = 1,9
1940	do jt = 1,5
1941	do jp = 1,13
1942	iprsm = 0
1943	do igc = 1,ngc(16)
1944	sumk = 0.
1945	do ipr = 1, ngn(ngs(15)+igc)
1946	iprsm = iprsm + 1
1947	sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+240)
1948	enddo
1949	ka(jn,jt,jp,igc) = sumk
1950	enddo
1951	enddo
1952	enddo
1953	enddo
1954
1955	do jt = 1,5
1956	do jp = 13,59
1957	iprsm = 0
1958	do igc = 1,ngc(16)
1959	sumk = 0.
1960	do ipr = 1, ngn(ngs(15)+igc)
1961	iprsm = iprsm + 1
1962	sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+240)
1963	enddo
1964	kb(jt,jp,igc) = sumk
1965	enddo
1966	enddo
1967	enddo
1968
1969	do jt = 1,10
1970	iprsm = 0
1971	do igc = 1,ngc(16)
1972	sumk = 0.
1973	do ipr = 1, ngn(ngs(15)+igc)
1974	iprsm = iprsm + 1
1975	sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+240)
1976	enddo
1977	selfref(jt,igc) = sumk
1978	enddo
1979	enddo
1980
1981	do jt = 1,4
1982	iprsm = 0
1983	do igc = 1,ngc(16)
1984	sumk = 0.
1985	do ipr = 1, ngn(ngs(15)+igc)
1986	iprsm = iprsm + 1
1987	sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+240)
1988	enddo
1989	forref(jt,igc) = sumk
1990	enddo
1991	enddo
1992
1993	iprsm = 0
1994	do igc = 1,ngc(16)
1995	sumf = 0.
1996	do ipr = 1, ngn(ngs(15)+igc)
1997	iprsm = iprsm + 1
1998	sumf = sumf + fracrefbo(iprsm)
1999	enddo
2000	fracrefb(igc) = sumf
2001	enddo
2002
2003	do jp = 1,9
2004	iprsm = 0
2005	do igc = 1,ngc(16)
2006	sumf = 0.
2007	do ipr = 1, ngn(ngs(15)+igc)
2008	iprsm = iprsm + 1
2009	sumf = sumf + fracrefao(iprsm,jp)
2010	enddo
2011	fracrefa(igc,jp) = sumf
2012	enddo
2013	enddo
2014
2015	end subroutine cmbgb16
2016
2017	!***************************************************************************
2018	subroutine lwcldpr
2019	!***************************************************************************
2020
2021	! --------- Modules ----------
2022
2023	use rrlw_cld, only: abscld1, absliq0, absliq1, &
2024	absice0, absice1, absice2, absice3
2025
2026	save
2027
2028	! ABSCLDn is the liquid water absorption coefficient (m2/g).
2029	! For INFLAG = 1.
2030	abscld1 = 0.0602410_rb
2031	!
2032	! Everything below is for INFLAG = 2.
2033
2034	! ABSICEn(J,IB) are the parameters needed to compute the liquid water
2035	! absorption coefficient in spectral region IB for ICEFLAG=n. The units
2036	! of ABSICEn(1,IB) are m2/g and ABSICEn(2,IB) has units (microns (m2/g)).
2037	! For ICEFLAG = 0.
2038
2039	absice0(:)= (/0.005_rb, 1.0_rb/)
2040
2041	! For ICEFLAG = 1.
2042	absice1(1,:) = (/0.0036_rb, 0.0068_rb, 0.0003_rb, 0.0016_rb, 0.0020_rb/)
2043	absice1(2,:) = (/1.136_rb , 0.600_rb , 1.338_rb , 1.166_rb , 1.118_rb /)
2044
2045	! For ICEFLAG = 2. In each band, the absorption
2046	! coefficients are listed for a range of effective radii from 5.0
2047	! to 131.0 microns in increments of 3.0 microns.
2048	! Spherical Ice Particle Parameterization
2049	! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)]
2050	absice2(:,1) = (/ &
2051	! band 1
2052	7.798999e-02_rb,6.340479e-02_rb,5.417973e-02_rb,4.766245e-02_rb,4.272663e-02_rb, &
2053	3.880939e-02_rb,3.559544e-02_rb,3.289241e-02_rb,3.057511e-02_rb,2.855800e-02_rb, &
2054	2.678022e-02_rb,2.519712e-02_rb,2.377505e-02_rb,2.248806e-02_rb,2.131578e-02_rb, &
2055	2.024194e-02_rb,1.925337e-02_rb,1.833926e-02_rb,1.749067e-02_rb,1.670007e-02_rb, &
2056	1.596113e-02_rb,1.526845e-02_rb,1.461739e-02_rb,1.400394e-02_rb,1.342462e-02_rb, &
2057	1.287639e-02_rb,1.235656e-02_rb,1.186279e-02_rb,1.139297e-02_rb,1.094524e-02_rb, &
2058	1.051794e-02_rb,1.010956e-02_rb,9.718755e-03_rb,9.344316e-03_rb,8.985139e-03_rb, &
2059	8.640223e-03_rb,8.308656e-03_rb,7.989606e-03_rb,7.682312e-03_rb,7.386076e-03_rb, &
2060	7.100255e-03_rb,6.824258e-03_rb,6.557540e-03_rb/)
2061	absice2(:,2) = (/ &
2062	! band 2
2063	2.784879e-02_rb,2.709863e-02_rb,2.619165e-02_rb,2.529230e-02_rb,2.443225e-02_rb, &
2064	2.361575e-02_rb,2.284021e-02_rb,2.210150e-02_rb,2.139548e-02_rb,2.071840e-02_rb, &
2065	2.006702e-02_rb,1.943856e-02_rb,1.883064e-02_rb,1.824120e-02_rb,1.766849e-02_rb, &
2066	1.711099e-02_rb,1.656737e-02_rb,1.603647e-02_rb,1.551727e-02_rb,1.500886e-02_rb, &
2067	1.451045e-02_rb,1.402132e-02_rb,1.354084e-02_rb,1.306842e-02_rb,1.260355e-02_rb, &
2068	1.214575e-02_rb,1.169460e-02_rb,1.124971e-02_rb,1.081072e-02_rb,1.037731e-02_rb, &
2069	9.949167e-03_rb,9.526021e-03_rb,9.107615e-03_rb,8.693714e-03_rb,8.284096e-03_rb, &
2070	7.878558e-03_rb,7.476910e-03_rb,7.078974e-03_rb,6.684586e-03_rb,6.293589e-03_rb, &
2071	5.905839e-03_rb,5.521200e-03_rb,5.139543e-03_rb/)
2072	absice2(:,3) = (/ &
2073	! band 3
2074	1.065397e-01_rb,8.005726e-02_rb,6.546428e-02_rb,5.589131e-02_rb,4.898681e-02_rb, &
2075	4.369932e-02_rb,3.947901e-02_rb,3.600676e-02_rb,3.308299e-02_rb,3.057561e-02_rb, &
2076	2.839325e-02_rb,2.647040e-02_rb,2.475872e-02_rb,2.322164e-02_rb,2.183091e-02_rb, &
2077	2.056430e-02_rb,1.940407e-02_rb,1.833586e-02_rb,1.734787e-02_rb,1.643034e-02_rb, &
2078	1.557512e-02_rb,1.477530e-02_rb,1.402501e-02_rb,1.331924e-02_rb,1.265364e-02_rb, &
2079	1.202445e-02_rb,1.142838e-02_rb,1.086257e-02_rb,1.032445e-02_rb,9.811791e-03_rb, &
2080	9.322587e-03_rb,8.855053e-03_rb,8.407591e-03_rb,7.978763e-03_rb,7.567273e-03_rb, &
2081	7.171949e-03_rb,6.791728e-03_rb,6.425642e-03_rb,6.072809e-03_rb,5.732424e-03_rb, &
2082	5.403748e-03_rb,5.086103e-03_rb,4.778865e-03_rb/)
2083	absice2(:,4) = (/ &
2084	! band 4
2085	1.804566e-01_rb,1.168987e-01_rb,8.680442e-02_rb,6.910060e-02_rb,5.738174e-02_rb, &
2086	4.902332e-02_rb,4.274585e-02_rb,3.784923e-02_rb,3.391734e-02_rb,3.068690e-02_rb, &
2087	2.798301e-02_rb,2.568480e-02_rb,2.370600e-02_rb,2.198337e-02_rb,2.046940e-02_rb, &
2088	1.912777e-02_rb,1.793016e-02_rb,1.685420e-02_rb,1.588193e-02_rb,1.499882e-02_rb, &
2089	1.419293e-02_rb,1.345440e-02_rb,1.277496e-02_rb,1.214769e-02_rb,1.156669e-02_rb, &
2090	1.102694e-02_rb,1.052412e-02_rb,1.005451e-02_rb,9.614854e-03_rb,9.202335e-03_rb, &
2091	8.814470e-03_rb,8.449077e-03_rb,8.104223e-03_rb,7.778195e-03_rb,7.469466e-03_rb, &
2092	7.176671e-03_rb,6.898588e-03_rb,6.634117e-03_rb,6.382264e-03_rb,6.142134e-03_rb, &
2093	5.912913e-03_rb,5.693862e-03_rb,5.484308e-03_rb/)
2094	absice2(:,5) = (/ &
2095	! band 5
2096	2.131806e-01_rb,1.311372e-01_rb,9.407171e-02_rb,7.299442e-02_rb,5.941273e-02_rb, &
2097	4.994043e-02_rb,4.296242e-02_rb,3.761113e-02_rb,3.337910e-02_rb,2.994978e-02_rb, &
2098	2.711556e-02_rb,2.473461e-02_rb,2.270681e-02_rb,2.095943e-02_rb,1.943839e-02_rb, &
2099	1.810267e-02_rb,1.692057e-02_rb,1.586719e-02_rb,1.492275e-02_rb,1.407132e-02_rb, &
2100	1.329989e-02_rb,1.259780e-02_rb,1.195618e-02_rb,1.136761e-02_rb,1.082583e-02_rb, &
2101	1.032552e-02_rb,9.862158e-03_rb,9.431827e-03_rb,9.031157e-03_rb,8.657217e-03_rb, &
2102	8.307449e-03_rb,7.979609e-03_rb,7.671724e-03_rb,7.382048e-03_rb,7.109032e-03_rb, &
2103	6.851298e-03_rb,6.607615e-03_rb,6.376881e-03_rb,6.158105e-03_rb,5.950394e-03_rb, &
2104	5.752942e-03_rb,5.565019e-03_rb,5.385963e-03_rb/)
2105	absice2(:,6) = (/ &
2106	! band 6
2107	1.546177e-01_rb,1.039251e-01_rb,7.910347e-02_rb,6.412429e-02_rb,5.399997e-02_rb, &
2108	4.664937e-02_rb,4.104237e-02_rb,3.660781e-02_rb,3.300218e-02_rb,3.000586e-02_rb, &
2109	2.747148e-02_rb,2.529633e-02_rb,2.340647e-02_rb,2.174723e-02_rb,2.027731e-02_rb, &
2110	1.896487e-02_rb,1.778492e-02_rb,1.671761e-02_rb,1.574692e-02_rb,1.485978e-02_rb, &
2111	1.404543e-02_rb,1.329489e-02_rb,1.260066e-02_rb,1.195636e-02_rb,1.135657e-02_rb, &
2112	1.079664e-02_rb,1.027257e-02_rb,9.780871e-03_rb,9.318505e-03_rb,8.882815e-03_rb, &
2113	8.471458e-03_rb,8.082364e-03_rb,7.713696e-03_rb,7.363817e-03_rb,7.031264e-03_rb, &
2114	6.714725e-03_rb,6.413021e-03_rb,6.125086e-03_rb,5.849958e-03_rb,5.586764e-03_rb, &
2115	5.334707e-03_rb,5.093066e-03_rb,4.861179e-03_rb/)
2116	absice2(:,7) = (/ &
2117	! band 7
2118	7.583404e-02_rb,6.181558e-02_rb,5.312027e-02_rb,4.696039e-02_rb,4.225986e-02_rb, &
2119	3.849735e-02_rb,3.538340e-02_rb,3.274182e-02_rb,3.045798e-02_rb,2.845343e-02_rb, &
2120	2.667231e-02_rb,2.507353e-02_rb,2.362606e-02_rb,2.230595e-02_rb,2.109435e-02_rb, &
2121	1.997617e-02_rb,1.893916e-02_rb,1.797328e-02_rb,1.707016e-02_rb,1.622279e-02_rb, &
2122	1.542523e-02_rb,1.467241e-02_rb,1.395997e-02_rb,1.328414e-02_rb,1.264164e-02_rb, &
2123	1.202958e-02_rb,1.144544e-02_rb,1.088697e-02_rb,1.035218e-02_rb,9.839297e-03_rb, &
2124	9.346733e-03_rb,8.873057e-03_rb,8.416980e-03_rb,7.977335e-03_rb,7.553066e-03_rb, &
2125	7.143210e-03_rb,6.746888e-03_rb,6.363297e-03_rb,5.991700e-03_rb,5.631422e-03_rb, &
2126	5.281840e-03_rb,4.942378e-03_rb,4.612505e-03_rb/)
2127	absice2(:,8) = (/ &
2128	! band 8
2129	9.022185e-02_rb,6.922700e-02_rb,5.710674e-02_rb,4.898377e-02_rb,4.305946e-02_rb, &
2130	3.849553e-02_rb,3.484183e-02_rb,3.183220e-02_rb,2.929794e-02_rb,2.712627e-02_rb, &
2131	2.523856e-02_rb,2.357810e-02_rb,2.210286e-02_rb,2.078089e-02_rb,1.958747e-02_rb, &
2132	1.850310e-02_rb,1.751218e-02_rb,1.660205e-02_rb,1.576232e-02_rb,1.498440e-02_rb, &
2133	1.426107e-02_rb,1.358624e-02_rb,1.295474e-02_rb,1.236212e-02_rb,1.180456e-02_rb, &
2134	1.127874e-02_rb,1.078175e-02_rb,1.031106e-02_rb,9.864433e-03_rb,9.439878e-03_rb, &
2135	9.035637e-03_rb,8.650140e-03_rb,8.281981e-03_rb,7.929895e-03_rb,7.592746e-03_rb, &
2136	7.269505e-03_rb,6.959238e-03_rb,6.661100e-03_rb,6.374317e-03_rb,6.098185e-03_rb, &
2137	5.832059e-03_rb,5.575347e-03_rb,5.327504e-03_rb/)
2138	absice2(:,9) = (/ &
2139	! band 9
2140	1.294087e-01_rb,8.788217e-02_rb,6.728288e-02_rb,5.479720e-02_rb,4.635049e-02_rb, &
2141	4.022253e-02_rb,3.555576e-02_rb,3.187259e-02_rb,2.888498e-02_rb,2.640843e-02_rb, &
2142	2.431904e-02_rb,2.253038e-02_rb,2.098024e-02_rb,1.962267e-02_rb,1.842293e-02_rb, &
2143	1.735426e-02_rb,1.639571e-02_rb,1.553060e-02_rb,1.474552e-02_rb,1.402953e-02_rb, &
2144	1.337363e-02_rb,1.277033e-02_rb,1.221336e-02_rb,1.169741e-02_rb,1.121797e-02_rb, &
2145	1.077117e-02_rb,1.035369e-02_rb,9.962643e-03_rb,9.595509e-03_rb,9.250088e-03_rb, &
2146	8.924447e-03_rb,8.616876e-03_rb,8.325862e-03_rb,8.050057e-03_rb,7.788258e-03_rb, &
2147	7.539388e-03_rb,7.302478e-03_rb,7.076656e-03_rb,6.861134e-03_rb,6.655197e-03_rb, &
2148	6.458197e-03_rb,6.269543e-03_rb,6.088697e-03_rb/)
2149	absice2(:,10) = (/ &
2150	! band 10
2151	1.593628e-01_rb,1.014552e-01_rb,7.458955e-02_rb,5.903571e-02_rb,4.887582e-02_rb, &
2152	4.171159e-02_rb,3.638480e-02_rb,3.226692e-02_rb,2.898717e-02_rb,2.631256e-02_rb, &
2153	2.408925e-02_rb,2.221156e-02_rb,2.060448e-02_rb,1.921325e-02_rb,1.799699e-02_rb, &
2154	1.692456e-02_rb,1.597177e-02_rb,1.511961e-02_rb,1.435289e-02_rb,1.365933e-02_rb, &
2155	1.302890e-02_rb,1.245334e-02_rb,1.192576e-02_rb,1.144037e-02_rb,1.099230e-02_rb, &
2156	1.057739e-02_rb,1.019208e-02_rb,9.833302e-03_rb,9.498395e-03_rb,9.185047e-03_rb, &
2157	8.891237e-03_rb,8.615185e-03_rb,8.355325e-03_rb,8.110267e-03_rb,7.878778e-03_rb, &
2158	7.659759e-03_rb,7.452224e-03_rb,7.255291e-03_rb,7.068166e-03_rb,6.890130e-03_rb, &
2159	6.720536e-03_rb,6.558794e-03_rb,6.404371e-03_rb/)
2160	absice2(:,11) = (/ &
2161	! band 11
2162	1.656227e-01_rb,1.032129e-01_rb,7.487359e-02_rb,5.871431e-02_rb,4.828355e-02_rb, &
2163	4.099989e-02_rb,3.562924e-02_rb,3.150755e-02_rb,2.824593e-02_rb,2.560156e-02_rb, &
2164	2.341503e-02_rb,2.157740e-02_rb,2.001169e-02_rb,1.866199e-02_rb,1.748669e-02_rb, &
2165	1.645421e-02_rb,1.554015e-02_rb,1.472535e-02_rb,1.399457e-02_rb,1.333553e-02_rb, &
2166	1.273821e-02_rb,1.219440e-02_rb,1.169725e-02_rb,1.124104e-02_rb,1.082096e-02_rb, &
2167	1.043290e-02_rb,1.007336e-02_rb,9.739338e-03_rb,9.428223e-03_rb,9.137756e-03_rb, &
2168	8.865964e-03_rb,8.611115e-03_rb,8.371686e-03_rb,8.146330e-03_rb,7.933852e-03_rb, &
2169	7.733187e-03_rb,7.543386e-03_rb,7.363597e-03_rb,7.193056e-03_rb,7.031072e-03_rb, &
2170	6.877024e-03_rb,6.730348e-03_rb,6.590531e-03_rb/)
2171	absice2(:,12) = (/ &
2172	! band 12
2173	9.194591e-02_rb,6.446867e-02_rb,4.962034e-02_rb,4.042061e-02_rb,3.418456e-02_rb, &
2174	2.968856e-02_rb,2.629900e-02_rb,2.365572e-02_rb,2.153915e-02_rb,1.980791e-02_rb, &
2175	1.836689e-02_rb,1.714979e-02_rb,1.610900e-02_rb,1.520946e-02_rb,1.442476e-02_rb, &
2176	1.373468e-02_rb,1.312345e-02_rb,1.257858e-02_rb,1.209010e-02_rb,1.164990e-02_rb, &
2177	1.125136e-02_rb,1.088901e-02_rb,1.055827e-02_rb,1.025531e-02_rb,9.976896e-03_rb, &
2178	9.720255e-03_rb,9.483022e-03_rb,9.263160e-03_rb,9.058902e-03_rb,8.868710e-03_rb, &
2179	8.691240e-03_rb,8.525312e-03_rb,8.369886e-03_rb,8.224042e-03_rb,8.086961e-03_rb, &
2180	7.957917e-03_rb,7.836258e-03_rb,7.721400e-03_rb,7.612821e-03_rb,7.510045e-03_rb, &
2181	7.412648e-03_rb,7.320242e-03_rb,7.232476e-03_rb/)
2182	absice2(:,13) = (/ &
2183	! band 13
2184	1.437021e-01_rb,8.872535e-02_rb,6.392420e-02_rb,4.991833e-02_rb,4.096790e-02_rb, &
2185	3.477881e-02_rb,3.025782e-02_rb,2.681909e-02_rb,2.412102e-02_rb,2.195132e-02_rb, &
2186	2.017124e-02_rb,1.868641e-02_rb,1.743044e-02_rb,1.635529e-02_rb,1.542540e-02_rb, &
2187	1.461388e-02_rb,1.390003e-02_rb,1.326766e-02_rb,1.270395e-02_rb,1.219860e-02_rb, &
2188	1.174326e-02_rb,1.133107e-02_rb,1.095637e-02_rb,1.061442e-02_rb,1.030126e-02_rb, &
2189	1.001352e-02_rb,9.748340e-03_rb,9.503256e-03_rb,9.276155e-03_rb,9.065205e-03_rb, &
2190	8.868808e-03_rb,8.685571e-03_rb,8.514268e-03_rb,8.353820e-03_rb,8.203272e-03_rb, &
2191	8.061776e-03_rb,7.928578e-03_rb,7.803001e-03_rb,7.684443e-03_rb,7.572358e-03_rb, &
2192	7.466258e-03_rb,7.365701e-03_rb,7.270286e-03_rb/)
2193	absice2(:,14) = (/ &
2194	! band 14
2195	1.288870e-01_rb,8.160295e-02_rb,5.964745e-02_rb,4.703790e-02_rb,3.888637e-02_rb, &
2196	3.320115e-02_rb,2.902017e-02_rb,2.582259e-02_rb,2.330224e-02_rb,2.126754e-02_rb, &
2197	1.959258e-02_rb,1.819130e-02_rb,1.700289e-02_rb,1.598320e-02_rb,1.509942e-02_rb, &
2198	1.432666e-02_rb,1.364572e-02_rb,1.304156e-02_rb,1.250220e-02_rb,1.201803e-02_rb, &
2199	1.158123e-02_rb,1.118537e-02_rb,1.082513e-02_rb,1.049605e-02_rb,1.019440e-02_rb, &
2200	9.916989e-03_rb,9.661116e-03_rb,9.424457e-03_rb,9.205005e-03_rb,9.001022e-03_rb, &
2201	8.810992e-03_rb,8.633588e-03_rb,8.467646e-03_rb,8.312137e-03_rb,8.166151e-03_rb, &
2202	8.028878e-03_rb,7.899597e-03_rb,7.777663e-03_rb,7.662498e-03_rb,7.553581e-03_rb, &
2203	7.450444e-03_rb,7.352662e-03_rb,7.259851e-03_rb/)
2204	absice2(:,15) = (/ &
2205	! band 15
2206	8.254229e-02_rb,5.808787e-02_rb,4.492166e-02_rb,3.675028e-02_rb,3.119623e-02_rb, &
2207	2.718045e-02_rb,2.414450e-02_rb,2.177073e-02_rb,1.986526e-02_rb,1.830306e-02_rb, &
2208	1.699991e-02_rb,1.589698e-02_rb,1.495199e-02_rb,1.413374e-02_rb,1.341870e-02_rb, &
2209	1.278883e-02_rb,1.223002e-02_rb,1.173114e-02_rb,1.128322e-02_rb,1.087900e-02_rb, &
2210	1.051254e-02_rb,1.017890e-02_rb,9.873991e-03_rb,9.594347e-03_rb,9.337044e-03_rb, &
2211	9.099589e-03_rb,8.879842e-03_rb,8.675960e-03_rb,8.486341e-03_rb,8.309594e-03_rb, &
2212	8.144500e-03_rb,7.989986e-03_rb,7.845109e-03_rb,7.709031e-03_rb,7.581007e-03_rb, &
2213	7.460376e-03_rb,7.346544e-03_rb,7.238978e-03_rb,7.137201e-03_rb,7.040780e-03_rb, &
2214	6.949325e-03_rb,6.862483e-03_rb,6.779931e-03_rb/)
2215	absice2(:,16) = (/ &
2216	! band 16
2217	1.382062e-01_rb,8.643227e-02_rb,6.282935e-02_rb,4.934783e-02_rb,4.063891e-02_rb, &
2218	3.455591e-02_rb,3.007059e-02_rb,2.662897e-02_rb,2.390631e-02_rb,2.169972e-02_rb, &
2219	1.987596e-02_rb,1.834393e-02_rb,1.703924e-02_rb,1.591513e-02_rb,1.493679e-02_rb, &
2220	1.407780e-02_rb,1.331775e-02_rb,1.264061e-02_rb,1.203364e-02_rb,1.148655e-02_rb, &
2221	1.099099e-02_rb,1.054006e-02_rb,1.012807e-02_rb,9.750215e-03_rb,9.402477e-03_rb, &
2222	9.081428e-03_rb,8.784143e-03_rb,8.508107e-03_rb,8.251146e-03_rb,8.011373e-03_rb, &
2223	7.787140e-03_rb,7.577002e-03_rb,7.379687e-03_rb,7.194071e-03_rb,7.019158e-03_rb, &
2224	6.854061e-03_rb,6.697986e-03_rb,6.550224e-03_rb,6.410138e-03_rb,6.277153e-03_rb, &
2225	6.150751e-03_rb,6.030462e-03_rb,5.915860e-03_rb/)
2226
2227	! ICEFLAG = 3; Fu parameterization. Particle size 5 - 140 micron in
2228	! increments of 3 microns.
2229	! units = m2/g
2230	! Hexagonal Ice Particle Parameterization
2231	! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)]
2232	absice3(:,1) = (/ &
2233	! band 1
2234	3.110649e-03_rb,4.666352e-02_rb,6.606447e-02_rb,6.531678e-02_rb,6.012598e-02_rb, &
2235	5.437494e-02_rb,4.906411e-02_rb,4.441146e-02_rb,4.040585e-02_rb,3.697334e-02_rb, &
2236	3.403027e-02_rb,3.149979e-02_rb,2.931596e-02_rb,2.742365e-02_rb,2.577721e-02_rb, &
2237	2.433888e-02_rb,2.307732e-02_rb,2.196644e-02_rb,2.098437e-02_rb,2.011264e-02_rb, &
2238	1.933561e-02_rb,1.863992e-02_rb,1.801407e-02_rb,1.744812e-02_rb,1.693346e-02_rb, &
2239	1.646252e-02_rb,1.602866e-02_rb,1.562600e-02_rb,1.524933e-02_rb,1.489399e-02_rb, &
2240	1.455580e-02_rb,1.423098e-02_rb,1.391612e-02_rb,1.360812e-02_rb,1.330413e-02_rb, &
2241	1.300156e-02_rb,1.269801e-02_rb,1.239127e-02_rb,1.207928e-02_rb,1.176014e-02_rb, &
2242	1.143204e-02_rb,1.109334e-02_rb,1.074243e-02_rb,1.037786e-02_rb,9.998198e-03_rb, &
2243	9.602126e-03_rb/)
2244	absice3(:,2) = (/ &
2245	! band 2
2246	3.984966e-04_rb,1.681097e-02_rb,2.627680e-02_rb,2.767465e-02_rb,2.700722e-02_rb, &
2247	2.579180e-02_rb,2.448677e-02_rb,2.323890e-02_rb,2.209096e-02_rb,2.104882e-02_rb, &
2248	2.010547e-02_rb,1.925003e-02_rb,1.847128e-02_rb,1.775883e-02_rb,1.710358e-02_rb, &
2249	1.649769e-02_rb,1.593449e-02_rb,1.540829e-02_rb,1.491429e-02_rb,1.444837e-02_rb, &
2250	1.400704e-02_rb,1.358729e-02_rb,1.318654e-02_rb,1.280258e-02_rb,1.243346e-02_rb, &
2251	1.207750e-02_rb,1.173325e-02_rb,1.139941e-02_rb,1.107487e-02_rb,1.075861e-02_rb, &
2252	1.044975e-02_rb,1.014753e-02_rb,9.851229e-03_rb,9.560240e-03_rb,9.274003e-03_rb, &
2253	8.992020e-03_rb,8.713845e-03_rb,8.439074e-03_rb,8.167346e-03_rb,7.898331e-03_rb, &
2254	7.631734e-03_rb,7.367286e-03_rb,7.104742e-03_rb,6.843882e-03_rb,6.584504e-03_rb, &
2255	6.326424e-03_rb/)
2256	absice3(:,3) = (/ &
2257	! band 3
2258	6.933163e-02_rb,8.540475e-02_rb,7.701816e-02_rb,6.771158e-02_rb,5.986953e-02_rb, &
2259	5.348120e-02_rb,4.824962e-02_rb,4.390563e-02_rb,4.024411e-02_rb,3.711404e-02_rb, &
2260	3.440426e-02_rb,3.203200e-02_rb,2.993478e-02_rb,2.806474e-02_rb,2.638464e-02_rb, &
2261	2.486516e-02_rb,2.348288e-02_rb,2.221890e-02_rb,2.105780e-02_rb,1.998687e-02_rb, &
2262	1.899552e-02_rb,1.807490e-02_rb,1.721750e-02_rb,1.641693e-02_rb,1.566773e-02_rb, &
2263	1.496515e-02_rb,1.430509e-02_rb,1.368398e-02_rb,1.309865e-02_rb,1.254634e-02_rb, &
2264	1.202456e-02_rb,1.153114e-02_rb,1.106409e-02_rb,1.062166e-02_rb,1.020224e-02_rb, &
2265	9.804381e-03_rb,9.426771e-03_rb,9.068205e-03_rb,8.727578e-03_rb,8.403876e-03_rb, &
2266	8.096160e-03_rb,7.803564e-03_rb,7.525281e-03_rb,7.260560e-03_rb,7.008697e-03_rb, &
2267	6.769036e-03_rb/)
2268	absice3(:,4) = (/ &
2269	! band 4
2270	1.765735e-01_rb,1.382700e-01_rb,1.095129e-01_rb,8.987475e-02_rb,7.591185e-02_rb, &
2271	6.554169e-02_rb,5.755500e-02_rb,5.122083e-02_rb,4.607610e-02_rb,4.181475e-02_rb, &
2272	3.822697e-02_rb,3.516432e-02_rb,3.251897e-02_rb,3.021073e-02_rb,2.817876e-02_rb, &
2273	2.637607e-02_rb,2.476582e-02_rb,2.331871e-02_rb,2.201113e-02_rb,2.082388e-02_rb, &
2274	1.974115e-02_rb,1.874983e-02_rb,1.783894e-02_rb,1.699922e-02_rb,1.622280e-02_rb, &
2275	1.550296e-02_rb,1.483390e-02_rb,1.421064e-02_rb,1.362880e-02_rb,1.308460e-02_rb, &
2276	1.257468e-02_rb,1.209611e-02_rb,1.164628e-02_rb,1.122287e-02_rb,1.082381e-02_rb, &
2277	1.044725e-02_rb,1.009154e-02_rb,9.755166e-03_rb,9.436783e-03_rb,9.135163e-03_rb, &
2278	8.849193e-03_rb,8.577856e-03_rb,8.320225e-03_rb,8.075451e-03_rb,7.842755e-03_rb, &
2279	7.621418e-03_rb/)
2280	absice3(:,5) = (/ &
2281	! band 5
2282	2.339673e-01_rb,1.692124e-01_rb,1.291656e-01_rb,1.033837e-01_rb,8.562949e-02_rb, &
2283	7.273526e-02_rb,6.298262e-02_rb,5.537015e-02_rb,4.927787e-02_rb,4.430246e-02_rb, &
2284	4.017061e-02_rb,3.669072e-02_rb,3.372455e-02_rb,3.116995e-02_rb,2.894977e-02_rb, &
2285	2.700471e-02_rb,2.528842e-02_rb,2.376420e-02_rb,2.240256e-02_rb,2.117959e-02_rb, &
2286	2.007567e-02_rb,1.907456e-02_rb,1.816271e-02_rb,1.732874e-02_rb,1.656300e-02_rb, &
2287	1.585725e-02_rb,1.520445e-02_rb,1.459852e-02_rb,1.403419e-02_rb,1.350689e-02_rb, &
2288	1.301260e-02_rb,1.254781e-02_rb,1.210941e-02_rb,1.169468e-02_rb,1.130118e-02_rb, &
2289	1.092675e-02_rb,1.056945e-02_rb,1.022757e-02_rb,9.899560e-03_rb,9.584021e-03_rb, &
2290	9.279705e-03_rb,8.985479e-03_rb,8.700322e-03_rb,8.423306e-03_rb,8.153590e-03_rb, &
2291	7.890412e-03_rb/)
2292	absice3(:,6) = (/ &
2293	! band 6
2294	1.145369e-01_rb,1.174566e-01_rb,9.917866e-02_rb,8.332990e-02_rb,7.104263e-02_rb, &
2295	6.153370e-02_rb,5.405472e-02_rb,4.806281e-02_rb,4.317918e-02_rb,3.913795e-02_rb, &
2296	3.574916e-02_rb,3.287437e-02_rb,3.041067e-02_rb,2.828017e-02_rb,2.642292e-02_rb, &
2297	2.479206e-02_rb,2.335051e-02_rb,2.206851e-02_rb,2.092195e-02_rb,1.989108e-02_rb, &
2298	1.895958e-02_rb,1.811385e-02_rb,1.734245e-02_rb,1.663573e-02_rb,1.598545e-02_rb, &
2299	1.538456e-02_rb,1.482700e-02_rb,1.430750e-02_rb,1.382150e-02_rb,1.336499e-02_rb, &
2300	1.293447e-02_rb,1.252685e-02_rb,1.213939e-02_rb,1.176968e-02_rb,1.141555e-02_rb, &
2301	1.107508e-02_rb,1.074655e-02_rb,1.042839e-02_rb,1.011923e-02_rb,9.817799e-03_rb, &
2302	9.522962e-03_rb,9.233688e-03_rb,8.949041e-03_rb,8.668171e-03_rb,8.390301e-03_rb, &
2303	8.114723e-03_rb/)
2304	absice3(:,7) = (/ &
2305	! band 7
2306	1.222345e-02_rb,5.344230e-02_rb,5.523465e-02_rb,5.128759e-02_rb,4.676925e-02_rb, &
2307	4.266150e-02_rb,3.910561e-02_rb,3.605479e-02_rb,3.342843e-02_rb,3.115052e-02_rb, &
2308	2.915776e-02_rb,2.739935e-02_rb,2.583499e-02_rb,2.443266e-02_rb,2.316681e-02_rb, &
2309	2.201687e-02_rb,2.096619e-02_rb,2.000112e-02_rb,1.911044e-02_rb,1.828481e-02_rb, &
2310	1.751641e-02_rb,1.679866e-02_rb,1.612598e-02_rb,1.549360e-02_rb,1.489742e-02_rb, &
2311	1.433392e-02_rb,1.380002e-02_rb,1.329305e-02_rb,1.281068e-02_rb,1.235084e-02_rb, &
2312	1.191172e-02_rb,1.149171e-02_rb,1.108936e-02_rb,1.070341e-02_rb,1.033271e-02_rb, &
2313	9.976220e-03_rb,9.633021e-03_rb,9.302273e-03_rb,8.983216e-03_rb,8.675161e-03_rb, &
2314	8.377478e-03_rb,8.089595e-03_rb,7.810986e-03_rb,7.541170e-03_rb,7.279706e-03_rb, &
2315	7.026186e-03_rb/)
2316	absice3(:,8) = (/ &
2317	! band 8
2318	6.711058e-02_rb,6.918198e-02_rb,6.127484e-02_rb,5.411944e-02_rb,4.836902e-02_rb, &
2319	4.375293e-02_rb,3.998077e-02_rb,3.683587e-02_rb,3.416508e-02_rb,3.186003e-02_rb, &
2320	2.984290e-02_rb,2.805671e-02_rb,2.645895e-02_rb,2.501733e-02_rb,2.370689e-02_rb, &
2321	2.250808e-02_rb,2.140532e-02_rb,2.038609e-02_rb,1.944018e-02_rb,1.855918e-02_rb, &
2322	1.773609e-02_rb,1.696504e-02_rb,1.624106e-02_rb,1.555990e-02_rb,1.491793e-02_rb, &
2323	1.431197e-02_rb,1.373928e-02_rb,1.319743e-02_rb,1.268430e-02_rb,1.219799e-02_rb, &
2324	1.173682e-02_rb,1.129925e-02_rb,1.088393e-02_rb,1.048961e-02_rb,1.011516e-02_rb, &
2325	9.759543e-03_rb,9.421813e-03_rb,9.101089e-03_rb,8.796559e-03_rb,8.507464e-03_rb, &
2326	8.233098e-03_rb,7.972798e-03_rb,7.725942e-03_rb,7.491940e-03_rb,7.270238e-03_rb, &
2327	7.060305e-03_rb/)
2328	absice3(:,9) = (/ &
2329	! band 9
2330	1.236780e-01_rb,9.222386e-02_rb,7.383997e-02_rb,6.204072e-02_rb,5.381029e-02_rb, &
2331	4.770678e-02_rb,4.296928e-02_rb,3.916131e-02_rb,3.601540e-02_rb,3.335878e-02_rb, &
2332	3.107493e-02_rb,2.908247e-02_rb,2.732282e-02_rb,2.575276e-02_rb,2.433968e-02_rb, &
2333	2.305852e-02_rb,2.188966e-02_rb,2.081757e-02_rb,1.982974e-02_rb,1.891599e-02_rb, &
2334	1.806794e-02_rb,1.727865e-02_rb,1.654227e-02_rb,1.585387e-02_rb,1.520924e-02_rb, &
2335	1.460476e-02_rb,1.403730e-02_rb,1.350416e-02_rb,1.300293e-02_rb,1.253153e-02_rb, &
2336	1.208808e-02_rb,1.167094e-02_rb,1.127862e-02_rb,1.090979e-02_rb,1.056323e-02_rb, &
2337	1.023786e-02_rb,9.932665e-03_rb,9.646744e-03_rb,9.379250e-03_rb,9.129409e-03_rb, &
2338	8.896500e-03_rb,8.679856e-03_rb,8.478852e-03_rb,8.292904e-03_rb,8.121463e-03_rb, &
2339	7.964013e-03_rb/)
2340	absice3(:,10) = (/ &
2341	! band 10
2342	1.655966e-01_rb,1.134205e-01_rb,8.714344e-02_rb,7.129241e-02_rb,6.063739e-02_rb, &
2343	5.294203e-02_rb,4.709309e-02_rb,4.247476e-02_rb,3.871892e-02_rb,3.559206e-02_rb, &
2344	3.293893e-02_rb,3.065226e-02_rb,2.865558e-02_rb,2.689288e-02_rb,2.532221e-02_rb, &
2345	2.391150e-02_rb,2.263582e-02_rb,2.147549e-02_rb,2.041476e-02_rb,1.944089e-02_rb, &
2346	1.854342e-02_rb,1.771371e-02_rb,1.694456e-02_rb,1.622989e-02_rb,1.556456e-02_rb, &
2347	1.494415e-02_rb,1.436491e-02_rb,1.382354e-02_rb,1.331719e-02_rb,1.284339e-02_rb, &
2348	1.239992e-02_rb,1.198486e-02_rb,1.159647e-02_rb,1.123323e-02_rb,1.089375e-02_rb, &
2349	1.057679e-02_rb,1.028124e-02_rb,1.000607e-02_rb,9.750376e-03_rb,9.513303e-03_rb, &
2350	9.294082e-03_rb,9.092003e-03_rb,8.906412e-03_rb,8.736702e-03_rb,8.582314e-03_rb, &
2351	8.442725e-03_rb/)
2352	absice3(:,11) = (/ &
2353	! band 11
2354	1.775615e-01_rb,1.180046e-01_rb,8.929607e-02_rb,7.233500e-02_rb,6.108333e-02_rb, &
2355	5.303642e-02_rb,4.696927e-02_rb,4.221206e-02_rb,3.836768e-02_rb,3.518576e-02_rb, &
2356	3.250063e-02_rb,3.019825e-02_rb,2.819758e-02_rb,2.643943e-02_rb,2.487953e-02_rb, &
2357	2.348414e-02_rb,2.222705e-02_rb,2.108762e-02_rb,2.004936e-02_rb,1.909892e-02_rb, &
2358	1.822539e-02_rb,1.741975e-02_rb,1.667449e-02_rb,1.598330e-02_rb,1.534084e-02_rb, &
2359	1.474253e-02_rb,1.418446e-02_rb,1.366325e-02_rb,1.317597e-02_rb,1.272004e-02_rb, &
2360	1.229321e-02_rb,1.189350e-02_rb,1.151915e-02_rb,1.116859e-02_rb,1.084042e-02_rb, &
2361	1.053338e-02_rb,1.024636e-02_rb,9.978326e-03_rb,9.728357e-03_rb,9.495613e-03_rb, &
2362	9.279327e-03_rb,9.078798e-03_rb,8.893383e-03_rb,8.722488e-03_rb,8.565568e-03_rb, &
2363	8.422115e-03_rb/)
2364	absice3(:,12) = (/ &
2365	! band 12
2366	9.465447e-02_rb,6.432047e-02_rb,5.060973e-02_rb,4.267283e-02_rb,3.741843e-02_rb, &
2367	3.363096e-02_rb,3.073531e-02_rb,2.842405e-02_rb,2.651789e-02_rb,2.490518e-02_rb, &
2368	2.351273e-02_rb,2.229056e-02_rb,2.120335e-02_rb,2.022541e-02_rb,1.933763e-02_rb, &
2369	1.852546e-02_rb,1.777763e-02_rb,1.708528e-02_rb,1.644134e-02_rb,1.584009e-02_rb, &
2370	1.527684e-02_rb,1.474774e-02_rb,1.424955e-02_rb,1.377957e-02_rb,1.333549e-02_rb, &
2371	1.291534e-02_rb,1.251743e-02_rb,1.214029e-02_rb,1.178265e-02_rb,1.144337e-02_rb, &
2372	1.112148e-02_rb,1.081609e-02_rb,1.052642e-02_rb,1.025178e-02_rb,9.991540e-03_rb, &
2373	9.745130e-03_rb,9.512038e-03_rb,9.291797e-03_rb,9.083980e-03_rb,8.888195e-03_rb, &
2374	8.704081e-03_rb,8.531306e-03_rb,8.369560e-03_rb,8.218558e-03_rb,8.078032e-03_rb, &
2375	7.947730e-03_rb/)
2376	absice3(:,13) = (/ &
2377	! band 13
2378	1.560311e-01_rb,9.961097e-02_rb,7.502949e-02_rb,6.115022e-02_rb,5.214952e-02_rb, &
2379	4.578149e-02_rb,4.099731e-02_rb,3.724174e-02_rb,3.419343e-02_rb,3.165356e-02_rb, &
2380	2.949251e-02_rb,2.762222e-02_rb,2.598073e-02_rb,2.452322e-02_rb,2.321642e-02_rb, &
2381	2.203516e-02_rb,2.096002e-02_rb,1.997579e-02_rb,1.907036e-02_rb,1.823401e-02_rb, &
2382	1.745879e-02_rb,1.673819e-02_rb,1.606678e-02_rb,1.544003e-02_rb,1.485411e-02_rb, &
2383	1.430574e-02_rb,1.379215e-02_rb,1.331092e-02_rb,1.285996e-02_rb,1.243746e-02_rb, &
2384	1.204183e-02_rb,1.167164e-02_rb,1.132567e-02_rb,1.100281e-02_rb,1.070207e-02_rb, &
2385	1.042258e-02_rb,1.016352e-02_rb,9.924197e-03_rb,9.703953e-03_rb,9.502199e-03_rb, &
2386	9.318400e-03_rb,9.152066e-03_rb,9.002749e-03_rb,8.870038e-03_rb,8.753555e-03_rb, &
2387	8.652951e-03_rb/)
2388	absice3(:,14) = (/ &
2389	! band 14
2390	1.559547e-01_rb,9.896700e-02_rb,7.441231e-02_rb,6.061469e-02_rb,5.168730e-02_rb, &
2391	4.537821e-02_rb,4.064106e-02_rb,3.692367e-02_rb,3.390714e-02_rb,3.139438e-02_rb, &
2392	2.925702e-02_rb,2.740783e-02_rb,2.578547e-02_rb,2.434552e-02_rb,2.305506e-02_rb, &
2393	2.188910e-02_rb,2.082842e-02_rb,1.985789e-02_rb,1.896553e-02_rb,1.814165e-02_rb, &
2394	1.737839e-02_rb,1.666927e-02_rb,1.600891e-02_rb,1.539279e-02_rb,1.481712e-02_rb, &
2395	1.427865e-02_rb,1.377463e-02_rb,1.330266e-02_rb,1.286068e-02_rb,1.244689e-02_rb, &
2396	1.205973e-02_rb,1.169780e-02_rb,1.135989e-02_rb,1.104492e-02_rb,1.075192e-02_rb, &
2397	1.048004e-02_rb,1.022850e-02_rb,9.996611e-03_rb,9.783753e-03_rb,9.589361e-03_rb, &
2398	9.412924e-03_rb,9.253977e-03_rb,9.112098e-03_rb,8.986903e-03_rb,8.878039e-03_rb, &
2399	8.785184e-03_rb/)
2400	absice3(:,15) = (/ &
2401	! band 15
2402	1.102926e-01_rb,7.176622e-02_rb,5.530316e-02_rb,4.606056e-02_rb,4.006116e-02_rb, &
2403	3.579628e-02_rb,3.256909e-02_rb,3.001360e-02_rb,2.791920e-02_rb,2.615617e-02_rb, &
2404	2.464023e-02_rb,2.331426e-02_rb,2.213817e-02_rb,2.108301e-02_rb,2.012733e-02_rb, &
2405	1.925493e-02_rb,1.845331e-02_rb,1.771269e-02_rb,1.702531e-02_rb,1.638493e-02_rb, &
2406	1.578648e-02_rb,1.522579e-02_rb,1.469940e-02_rb,1.420442e-02_rb,1.373841e-02_rb, &
2407	1.329931e-02_rb,1.288535e-02_rb,1.249502e-02_rb,1.212700e-02_rb,1.178015e-02_rb, &
2408	1.145348e-02_rb,1.114612e-02_rb,1.085730e-02_rb,1.058633e-02_rb,1.033263e-02_rb, &
2409	1.009564e-02_rb,9.874895e-03_rb,9.669960e-03_rb,9.480449e-03_rb,9.306014e-03_rb, &
2410	9.146339e-03_rb,9.001138e-03_rb,8.870154e-03_rb,8.753148e-03_rb,8.649907e-03_rb, &
2411	8.560232e-03_rb/)
2412	absice3(:,16) = (/ &
2413	! band 16
2414	1.688344e-01_rb,1.077072e-01_rb,7.994467e-02_rb,6.403862e-02_rb,5.369850e-02_rb, &
2415	4.641582e-02_rb,4.099331e-02_rb,3.678724e-02_rb,3.342069e-02_rb,3.065831e-02_rb, &
2416	2.834557e-02_rb,2.637680e-02_rb,2.467733e-02_rb,2.319286e-02_rb,2.188299e-02_rb, &
2417	2.071701e-02_rb,1.967121e-02_rb,1.872692e-02_rb,1.786931e-02_rb,1.708641e-02_rb, &
2418	1.636846e-02_rb,1.570743e-02_rb,1.509665e-02_rb,1.453052e-02_rb,1.400433e-02_rb, &
2419	1.351407e-02_rb,1.305631e-02_rb,1.262810e-02_rb,1.222688e-02_rb,1.185044e-02_rb, &
2420	1.149683e-02_rb,1.116436e-02_rb,1.085153e-02_rb,1.055701e-02_rb,1.027961e-02_rb, &
2421	1.001831e-02_rb,9.772141e-03_rb,9.540280e-03_rb,9.321966e-03_rb,9.116517e-03_rb, &
2422	8.923315e-03_rb,8.741803e-03_rb,8.571472e-03_rb,8.411860e-03_rb,8.262543e-03_rb, &
2423	8.123136e-03_rb/)
2424
2425	! For LIQFLAG = 0.
2426	absliq0 = 0.0903614_rb
2427
2428	! For LIQFLAG = 1. In each band, the absorption
2429	! coefficients are listed for a range of effective radii from 2.5
2430	! to 59.5 microns in increments of 1.0 micron.
2431	absliq1(:, 1) = (/ &
2432	! band 1
2433	1.64047e-03_rb, 6.90533e-02_rb, 7.72017e-02_rb, 7.78054e-02_rb, 7.69523e-02_rb, &
2434	7.58058e-02_rb, 7.46400e-02_rb, 7.35123e-02_rb, 7.24162e-02_rb, 7.13225e-02_rb, &
2435	6.99145e-02_rb, 6.66409e-02_rb, 6.36582e-02_rb, 6.09425e-02_rb, 5.84593e-02_rb, &
2436	5.61743e-02_rb, 5.40571e-02_rb, 5.20812e-02_rb, 5.02245e-02_rb, 4.84680e-02_rb, &
2437	4.67959e-02_rb, 4.51944e-02_rb, 4.36516e-02_rb, 4.21570e-02_rb, 4.07015e-02_rb, &
2438	3.92766e-02_rb, 3.78747e-02_rb, 3.64886e-02_rb, 3.53632e-02_rb, 3.41992e-02_rb, &
2439	3.31016e-02_rb, 3.20643e-02_rb, 3.10817e-02_rb, 3.01490e-02_rb, 2.92620e-02_rb, &
2440	2.84171e-02_rb, 2.76108e-02_rb, 2.68404e-02_rb, 2.61031e-02_rb, 2.53966e-02_rb, &
2441	2.47189e-02_rb, 2.40678e-02_rb, 2.34418e-02_rb, 2.28392e-02_rb, 2.22586e-02_rb, &
2442	2.16986e-02_rb, 2.11580e-02_rb, 2.06356e-02_rb, 2.01305e-02_rb, 1.96417e-02_rb, &
2443	1.91682e-02_rb, 1.87094e-02_rb, 1.82643e-02_rb, 1.78324e-02_rb, 1.74129e-02_rb, &
2444	1.70052e-02_rb, 1.66088e-02_rb, 1.62231e-02_rb/)
2445	absliq1(:, 2) = (/ &
2446	! band 2
2447	2.19486e-01_rb, 1.80687e-01_rb, 1.59150e-01_rb, 1.44731e-01_rb, 1.33703e-01_rb, &
2448	1.24355e-01_rb, 1.15756e-01_rb, 1.07318e-01_rb, 9.86119e-02_rb, 8.92739e-02_rb, &
2449	8.34911e-02_rb, 7.70773e-02_rb, 7.15240e-02_rb, 6.66615e-02_rb, 6.23641e-02_rb, &
2450	5.85359e-02_rb, 5.51020e-02_rb, 5.20032e-02_rb, 4.91916e-02_rb, 4.66283e-02_rb, &
2451	4.42813e-02_rb, 4.21236e-02_rb, 4.01330e-02_rb, 3.82905e-02_rb, 3.65797e-02_rb, &
2452	3.49869e-02_rb, 3.35002e-02_rb, 3.21090e-02_rb, 3.08957e-02_rb, 2.97601e-02_rb, &
2453	2.86966e-02_rb, 2.76984e-02_rb, 2.67599e-02_rb, 2.58758e-02_rb, 2.50416e-02_rb, &
2454	2.42532e-02_rb, 2.35070e-02_rb, 2.27997e-02_rb, 2.21284e-02_rb, 2.14904e-02_rb, &
2455	2.08834e-02_rb, 2.03051e-02_rb, 1.97536e-02_rb, 1.92271e-02_rb, 1.87239e-02_rb, &
2456	1.82425e-02_rb, 1.77816e-02_rb, 1.73399e-02_rb, 1.69162e-02_rb, 1.65094e-02_rb, &
2457	1.61187e-02_rb, 1.57430e-02_rb, 1.53815e-02_rb, 1.50334e-02_rb, 1.46981e-02_rb, &
2458	1.43748e-02_rb, 1.40628e-02_rb, 1.37617e-02_rb/)
2459	absliq1(:, 3) = (/ &
2460	! band 3
2461	2.95174e-01_rb, 2.34765e-01_rb, 1.98038e-01_rb, 1.72114e-01_rb, 1.52083e-01_rb, &
2462	1.35654e-01_rb, 1.21613e-01_rb, 1.09252e-01_rb, 9.81263e-02_rb, 8.79448e-02_rb, &
2463	8.12566e-02_rb, 7.44563e-02_rb, 6.86374e-02_rb, 6.36042e-02_rb, 5.92094e-02_rb, &
2464	5.53402e-02_rb, 5.19087e-02_rb, 4.88455e-02_rb, 4.60951e-02_rb, 4.36124e-02_rb, &
2465	4.13607e-02_rb, 3.93096e-02_rb, 3.74338e-02_rb, 3.57119e-02_rb, 3.41261e-02_rb, &
2466	3.26610e-02_rb, 3.13036e-02_rb, 3.00425e-02_rb, 2.88497e-02_rb, 2.78077e-02_rb, &
2467	2.68317e-02_rb, 2.59158e-02_rb, 2.50545e-02_rb, 2.42430e-02_rb, 2.34772e-02_rb, &
2468	2.27533e-02_rb, 2.20679e-02_rb, 2.14181e-02_rb, 2.08011e-02_rb, 2.02145e-02_rb, &
2469	1.96561e-02_rb, 1.91239e-02_rb, 1.86161e-02_rb, 1.81311e-02_rb, 1.76673e-02_rb, &
2470	1.72234e-02_rb, 1.67981e-02_rb, 1.63903e-02_rb, 1.59989e-02_rb, 1.56230e-02_rb, &
2471	1.52615e-02_rb, 1.49138e-02_rb, 1.45791e-02_rb, 1.42565e-02_rb, 1.39455e-02_rb, &
2472	1.36455e-02_rb, 1.33559e-02_rb, 1.30761e-02_rb/)
2473	absliq1(:, 4) = (/ &
2474	! band 4
2475	3.00925e-01_rb, 2.36949e-01_rb, 1.96947e-01_rb, 1.68692e-01_rb, 1.47190e-01_rb, &
2476	1.29986e-01_rb, 1.15719e-01_rb, 1.03568e-01_rb, 9.30028e-02_rb, 8.36658e-02_rb, &
2477	7.71075e-02_rb, 7.07002e-02_rb, 6.52284e-02_rb, 6.05024e-02_rb, 5.63801e-02_rb, &
2478	5.27534e-02_rb, 4.95384e-02_rb, 4.66690e-02_rb, 4.40925e-02_rb, 4.17664e-02_rb, &
2479	3.96559e-02_rb, 3.77326e-02_rb, 3.59727e-02_rb, 3.43561e-02_rb, 3.28662e-02_rb, &
2480	3.14885e-02_rb, 3.02110e-02_rb, 2.90231e-02_rb, 2.78948e-02_rb, 2.69109e-02_rb, &
2481	2.59884e-02_rb, 2.51217e-02_rb, 2.43058e-02_rb, 2.35364e-02_rb, 2.28096e-02_rb, &
2482	2.21218e-02_rb, 2.14700e-02_rb, 2.08515e-02_rb, 2.02636e-02_rb, 1.97041e-02_rb, &
2483	1.91711e-02_rb, 1.86625e-02_rb, 1.81769e-02_rb, 1.77126e-02_rb, 1.72683e-02_rb, &
2484	1.68426e-02_rb, 1.64344e-02_rb, 1.60427e-02_rb, 1.56664e-02_rb, 1.53046e-02_rb, &
2485	1.49565e-02_rb, 1.46214e-02_rb, 1.42985e-02_rb, 1.39871e-02_rb, 1.36866e-02_rb, &
2486	1.33965e-02_rb, 1.31162e-02_rb, 1.28453e-02_rb/)
2487	absliq1(:, 5) = (/ &
2488	! band 5
2489	2.64691e-01_rb, 2.12018e-01_rb, 1.78009e-01_rb, 1.53539e-01_rb, 1.34721e-01_rb, &
2490	1.19580e-01_rb, 1.06996e-01_rb, 9.62772e-02_rb, 8.69710e-02_rb, 7.87670e-02_rb, &
2491	7.29272e-02_rb, 6.70920e-02_rb, 6.20977e-02_rb, 5.77732e-02_rb, 5.39910e-02_rb, &
2492	5.06538e-02_rb, 4.76866e-02_rb, 4.50301e-02_rb, 4.26374e-02_rb, 4.04704e-02_rb, &
2493	3.84981e-02_rb, 3.66948e-02_rb, 3.50394e-02_rb, 3.35141e-02_rb, 3.21038e-02_rb, &
2494	3.07957e-02_rb, 2.95788e-02_rb, 2.84438e-02_rb, 2.73790e-02_rb, 2.64390e-02_rb, &
2495	2.55565e-02_rb, 2.47263e-02_rb, 2.39437e-02_rb, 2.32047e-02_rb, 2.25056e-02_rb, &
2496	2.18433e-02_rb, 2.12149e-02_rb, 2.06177e-02_rb, 2.00495e-02_rb, 1.95081e-02_rb, &
2497	1.89917e-02_rb, 1.84984e-02_rb, 1.80269e-02_rb, 1.75755e-02_rb, 1.71431e-02_rb, &
2498	1.67283e-02_rb, 1.63303e-02_rb, 1.59478e-02_rb, 1.55801e-02_rb, 1.52262e-02_rb, &
2499	1.48853e-02_rb, 1.45568e-02_rb, 1.42400e-02_rb, 1.39342e-02_rb, 1.36388e-02_rb, &
2500	1.33533e-02_rb, 1.30773e-02_rb, 1.28102e-02_rb/)
2501	absliq1(:, 6) = (/ &
2502	! band 6
2503	8.81182e-02_rb, 1.06745e-01_rb, 9.79753e-02_rb, 8.99625e-02_rb, 8.35200e-02_rb, &
2504	7.81899e-02_rb, 7.35939e-02_rb, 6.94696e-02_rb, 6.56266e-02_rb, 6.19148e-02_rb, &
2505	5.83355e-02_rb, 5.49306e-02_rb, 5.19642e-02_rb, 4.93325e-02_rb, 4.69659e-02_rb, &
2506	4.48148e-02_rb, 4.28431e-02_rb, 4.10231e-02_rb, 3.93332e-02_rb, 3.77563e-02_rb, &
2507	3.62785e-02_rb, 3.48882e-02_rb, 3.35758e-02_rb, 3.23333e-02_rb, 3.11536e-02_rb, &
2508	3.00310e-02_rb, 2.89601e-02_rb, 2.79365e-02_rb, 2.70502e-02_rb, 2.62618e-02_rb, &
2509	2.55025e-02_rb, 2.47728e-02_rb, 2.40726e-02_rb, 2.34013e-02_rb, 2.27583e-02_rb, &
2510	2.21422e-02_rb, 2.15522e-02_rb, 2.09869e-02_rb, 2.04453e-02_rb, 1.99260e-02_rb, &
2511	1.94280e-02_rb, 1.89501e-02_rb, 1.84913e-02_rb, 1.80506e-02_rb, 1.76270e-02_rb, &
2512	1.72196e-02_rb, 1.68276e-02_rb, 1.64500e-02_rb, 1.60863e-02_rb, 1.57357e-02_rb, &
2513	1.53975e-02_rb, 1.50710e-02_rb, 1.47558e-02_rb, 1.44511e-02_rb, 1.41566e-02_rb, &
2514	1.38717e-02_rb, 1.35960e-02_rb, 1.33290e-02_rb/)
2515	absliq1(:, 7) = (/ &
2516	! band 7
2517	4.32174e-02_rb, 7.36078e-02_rb, 6.98340e-02_rb, 6.65231e-02_rb, 6.41948e-02_rb, &
2518	6.23551e-02_rb, 6.06638e-02_rb, 5.88680e-02_rb, 5.67124e-02_rb, 5.38629e-02_rb, &
2519	4.99579e-02_rb, 4.86289e-02_rb, 4.70120e-02_rb, 4.52854e-02_rb, 4.35466e-02_rb, &
2520	4.18480e-02_rb, 4.02169e-02_rb, 3.86658e-02_rb, 3.71992e-02_rb, 3.58168e-02_rb, &
2521	3.45155e-02_rb, 3.32912e-02_rb, 3.21390e-02_rb, 3.10538e-02_rb, 3.00307e-02_rb, &
2522	2.90651e-02_rb, 2.81524e-02_rb, 2.72885e-02_rb, 2.62821e-02_rb, 2.55744e-02_rb, &
2523	2.48799e-02_rb, 2.42029e-02_rb, 2.35460e-02_rb, 2.29108e-02_rb, 2.22981e-02_rb, &
2524	2.17079e-02_rb, 2.11402e-02_rb, 2.05945e-02_rb, 2.00701e-02_rb, 1.95663e-02_rb, &
2525	1.90824e-02_rb, 1.86174e-02_rb, 1.81706e-02_rb, 1.77411e-02_rb, 1.73281e-02_rb, &
2526	1.69307e-02_rb, 1.65483e-02_rb, 1.61801e-02_rb, 1.58254e-02_rb, 1.54835e-02_rb, &
2527	1.51538e-02_rb, 1.48358e-02_rb, 1.45288e-02_rb, 1.42322e-02_rb, 1.39457e-02_rb, &
2528	1.36687e-02_rb, 1.34008e-02_rb, 1.31416e-02_rb/)
2529	absliq1(:, 8) = (/ &
2530	! band 8
2531	1.41881e-01_rb, 7.15419e-02_rb, 6.30335e-02_rb, 6.11132e-02_rb, 6.01931e-02_rb, &
2532	5.92420e-02_rb, 5.78968e-02_rb, 5.58876e-02_rb, 5.28923e-02_rb, 4.84462e-02_rb, &
2533	4.60839e-02_rb, 4.56013e-02_rb, 4.45410e-02_rb, 4.31866e-02_rb, 4.17026e-02_rb, &
2534	4.01850e-02_rb, 3.86892e-02_rb, 3.72461e-02_rb, 3.58722e-02_rb, 3.45749e-02_rb, &
2535	3.33564e-02_rb, 3.22155e-02_rb, 3.11494e-02_rb, 3.01541e-02_rb, 2.92253e-02_rb, &
2536	2.83584e-02_rb, 2.75488e-02_rb, 2.67925e-02_rb, 2.57692e-02_rb, 2.50704e-02_rb, &
2537	2.43918e-02_rb, 2.37350e-02_rb, 2.31005e-02_rb, 2.24888e-02_rb, 2.18996e-02_rb, &
2538	2.13325e-02_rb, 2.07870e-02_rb, 2.02623e-02_rb, 1.97577e-02_rb, 1.92724e-02_rb, &
2539	1.88056e-02_rb, 1.83564e-02_rb, 1.79241e-02_rb, 1.75079e-02_rb, 1.71070e-02_rb, &
2540	1.67207e-02_rb, 1.63482e-02_rb, 1.59890e-02_rb, 1.56424e-02_rb, 1.53077e-02_rb, &
2541	1.49845e-02_rb, 1.46722e-02_rb, 1.43702e-02_rb, 1.40782e-02_rb, 1.37955e-02_rb, &
2542	1.35219e-02_rb, 1.32569e-02_rb, 1.30000e-02_rb/)
2543	absliq1(:, 9) = (/ &
2544	! band 9
2545	6.72726e-02_rb, 6.61013e-02_rb, 6.47866e-02_rb, 6.33780e-02_rb, 6.18985e-02_rb, &
2546	6.03335e-02_rb, 5.86136e-02_rb, 5.65876e-02_rb, 5.39839e-02_rb, 5.03536e-02_rb, &
2547	4.71608e-02_rb, 4.63630e-02_rb, 4.50313e-02_rb, 4.34526e-02_rb, 4.17876e-02_rb, &
2548	4.01261e-02_rb, 3.85171e-02_rb, 3.69860e-02_rb, 3.55442e-02_rb, 3.41954e-02_rb, &
2549	3.29384e-02_rb, 3.17693e-02_rb, 3.06832e-02_rb, 2.96745e-02_rb, 2.87374e-02_rb, &
2550	2.78662e-02_rb, 2.70557e-02_rb, 2.63008e-02_rb, 2.52450e-02_rb, 2.45424e-02_rb, &
2551	2.38656e-02_rb, 2.32144e-02_rb, 2.25885e-02_rb, 2.19873e-02_rb, 2.14099e-02_rb, &
2552	2.08554e-02_rb, 2.03230e-02_rb, 1.98116e-02_rb, 1.93203e-02_rb, 1.88482e-02_rb, &
2553	1.83944e-02_rb, 1.79578e-02_rb, 1.75378e-02_rb, 1.71335e-02_rb, 1.67440e-02_rb, &
2554	1.63687e-02_rb, 1.60069e-02_rb, 1.56579e-02_rb, 1.53210e-02_rb, 1.49958e-02_rb, &
2555	1.46815e-02_rb, 1.43778e-02_rb, 1.40841e-02_rb, 1.37999e-02_rb, 1.35249e-02_rb, &
2556	1.32585e-02_rb, 1.30004e-02_rb, 1.27502e-02_rb/)
2557	absliq1(:,10) = (/ &
2558	! band 10
2559	7.97040e-02_rb, 7.63844e-02_rb, 7.36499e-02_rb, 7.13525e-02_rb, 6.93043e-02_rb, &
2560	6.72807e-02_rb, 6.50227e-02_rb, 6.22395e-02_rb, 5.86093e-02_rb, 5.37815e-02_rb, &
2561	5.14682e-02_rb, 4.97214e-02_rb, 4.77392e-02_rb, 4.56961e-02_rb, 4.36858e-02_rb, &
2562	4.17569e-02_rb, 3.99328e-02_rb, 3.82224e-02_rb, 3.66265e-02_rb, 3.51416e-02_rb, &
2563	3.37617e-02_rb, 3.24798e-02_rb, 3.12887e-02_rb, 3.01812e-02_rb, 2.91505e-02_rb, &
2564	2.81900e-02_rb, 2.72939e-02_rb, 2.64568e-02_rb, 2.54165e-02_rb, 2.46832e-02_rb, &
2565	2.39783e-02_rb, 2.33017e-02_rb, 2.26531e-02_rb, 2.20314e-02_rb, 2.14359e-02_rb, &
2566	2.08653e-02_rb, 2.03187e-02_rb, 1.97947e-02_rb, 1.92924e-02_rb, 1.88106e-02_rb, &
2567	1.83483e-02_rb, 1.79043e-02_rb, 1.74778e-02_rb, 1.70678e-02_rb, 1.66735e-02_rb, &
2568	1.62941e-02_rb, 1.59286e-02_rb, 1.55766e-02_rb, 1.52371e-02_rb, 1.49097e-02_rb, &
2569	1.45937e-02_rb, 1.42885e-02_rb, 1.39936e-02_rb, 1.37085e-02_rb, 1.34327e-02_rb, &
2570	1.31659e-02_rb, 1.29075e-02_rb, 1.26571e-02_rb/)
2571	absliq1(:,11) = (/ &
2572	! band 11
2573	1.49438e-01_rb, 1.33535e-01_rb, 1.21542e-01_rb, 1.11743e-01_rb, 1.03263e-01_rb, &
2574	9.55774e-02_rb, 8.83382e-02_rb, 8.12943e-02_rb, 7.42533e-02_rb, 6.70609e-02_rb, &
2575	6.38761e-02_rb, 5.97788e-02_rb, 5.59841e-02_rb, 5.25318e-02_rb, 4.94132e-02_rb, &
2576	4.66014e-02_rb, 4.40644e-02_rb, 4.17706e-02_rb, 3.96910e-02_rb, 3.77998e-02_rb, &
2577	3.60742e-02_rb, 3.44947e-02_rb, 3.30442e-02_rb, 3.17079e-02_rb, 3.04730e-02_rb, &
2578	2.93283e-02_rb, 2.82642e-02_rb, 2.72720e-02_rb, 2.61789e-02_rb, 2.53277e-02_rb, &
2579	2.45237e-02_rb, 2.37635e-02_rb, 2.30438e-02_rb, 2.23615e-02_rb, 2.17140e-02_rb, &
2580	2.10987e-02_rb, 2.05133e-02_rb, 1.99557e-02_rb, 1.94241e-02_rb, 1.89166e-02_rb, &
2581	1.84317e-02_rb, 1.79679e-02_rb, 1.75238e-02_rb, 1.70983e-02_rb, 1.66901e-02_rb, &
2582	1.62983e-02_rb, 1.59219e-02_rb, 1.55599e-02_rb, 1.52115e-02_rb, 1.48761e-02_rb, &
2583	1.45528e-02_rb, 1.42411e-02_rb, 1.39402e-02_rb, 1.36497e-02_rb, 1.33690e-02_rb, &
2584	1.30976e-02_rb, 1.28351e-02_rb, 1.25810e-02_rb/)
2585	absliq1(:,12) = (/ &
2586	! band 12
2587	3.71985e-02_rb, 3.88586e-02_rb, 3.99070e-02_rb, 4.04351e-02_rb, 4.04610e-02_rb, &
2588	3.99834e-02_rb, 3.89953e-02_rb, 3.74886e-02_rb, 3.54551e-02_rb, 3.28870e-02_rb, &
2589	3.32576e-02_rb, 3.22444e-02_rb, 3.12384e-02_rb, 3.02584e-02_rb, 2.93146e-02_rb, &
2590	2.84120e-02_rb, 2.75525e-02_rb, 2.67361e-02_rb, 2.59618e-02_rb, 2.52280e-02_rb, &
2591	2.45327e-02_rb, 2.38736e-02_rb, 2.32487e-02_rb, 2.26558e-02_rb, 2.20929e-02_rb, &
2592	2.15579e-02_rb, 2.10491e-02_rb, 2.05648e-02_rb, 1.99749e-02_rb, 1.95704e-02_rb, &
2593	1.91731e-02_rb, 1.87839e-02_rb, 1.84032e-02_rb, 1.80315e-02_rb, 1.76689e-02_rb, &
2594	1.73155e-02_rb, 1.69712e-02_rb, 1.66362e-02_rb, 1.63101e-02_rb, 1.59928e-02_rb, &
2595	1.56842e-02_rb, 1.53840e-02_rb, 1.50920e-02_rb, 1.48080e-02_rb, 1.45318e-02_rb, &
2596	1.42631e-02_rb, 1.40016e-02_rb, 1.37472e-02_rb, 1.34996e-02_rb, 1.32586e-02_rb, &
2597	1.30239e-02_rb, 1.27954e-02_rb, 1.25728e-02_rb, 1.23559e-02_rb, 1.21445e-02_rb, &
2598	1.19385e-02_rb, 1.17376e-02_rb, 1.15417e-02_rb/)
2599	absliq1(:,13) = (/ &
2600	! band 13
2601	3.11868e-02_rb, 4.48357e-02_rb, 4.90224e-02_rb, 4.96406e-02_rb, 4.86806e-02_rb, &
2602	4.69610e-02_rb, 4.48630e-02_rb, 4.25795e-02_rb, 4.02138e-02_rb, 3.78236e-02_rb, &
2603	3.74266e-02_rb, 3.60384e-02_rb, 3.47074e-02_rb, 3.34434e-02_rb, 3.22499e-02_rb, &
2604	3.11264e-02_rb, 3.00704e-02_rb, 2.90784e-02_rb, 2.81463e-02_rb, 2.72702e-02_rb, &
2605	2.64460e-02_rb, 2.56698e-02_rb, 2.49381e-02_rb, 2.42475e-02_rb, 2.35948e-02_rb, &
2606	2.29774e-02_rb, 2.23925e-02_rb, 2.18379e-02_rb, 2.11793e-02_rb, 2.07076e-02_rb, &
2607	2.02470e-02_rb, 1.97981e-02_rb, 1.93613e-02_rb, 1.89367e-02_rb, 1.85243e-02_rb, &
2608	1.81240e-02_rb, 1.77356e-02_rb, 1.73588e-02_rb, 1.69935e-02_rb, 1.66392e-02_rb, &
2609	1.62956e-02_rb, 1.59624e-02_rb, 1.56393e-02_rb, 1.53259e-02_rb, 1.50219e-02_rb, &
2610	1.47268e-02_rb, 1.44404e-02_rb, 1.41624e-02_rb, 1.38925e-02_rb, 1.36302e-02_rb, &
2611	1.33755e-02_rb, 1.31278e-02_rb, 1.28871e-02_rb, 1.26530e-02_rb, 1.24253e-02_rb, &
2612	1.22038e-02_rb, 1.19881e-02_rb, 1.17782e-02_rb/)
2613	absliq1(:,14) = (/ &
2614	! band 14
2615	1.58988e-02_rb, 3.50652e-02_rb, 4.00851e-02_rb, 4.07270e-02_rb, 3.98101e-02_rb, &
2616	3.83306e-02_rb, 3.66829e-02_rb, 3.50327e-02_rb, 3.34497e-02_rb, 3.19609e-02_rb, &
2617	3.13712e-02_rb, 3.03348e-02_rb, 2.93415e-02_rb, 2.83973e-02_rb, 2.75037e-02_rb, &
2618	2.66604e-02_rb, 2.58654e-02_rb, 2.51161e-02_rb, 2.44100e-02_rb, 2.37440e-02_rb, &
2619	2.31154e-02_rb, 2.25215e-02_rb, 2.19599e-02_rb, 2.14282e-02_rb, 2.09242e-02_rb, &
2620	2.04459e-02_rb, 1.99915e-02_rb, 1.95594e-02_rb, 1.90254e-02_rb, 1.86598e-02_rb, &
2621	1.82996e-02_rb, 1.79455e-02_rb, 1.75983e-02_rb, 1.72584e-02_rb, 1.69260e-02_rb, &
2622	1.66013e-02_rb, 1.62843e-02_rb, 1.59752e-02_rb, 1.56737e-02_rb, 1.53799e-02_rb, &
2623	1.50936e-02_rb, 1.48146e-02_rb, 1.45429e-02_rb, 1.42782e-02_rb, 1.40203e-02_rb, &
2624	1.37691e-02_rb, 1.35243e-02_rb, 1.32858e-02_rb, 1.30534e-02_rb, 1.28270e-02_rb, &
2625	1.26062e-02_rb, 1.23909e-02_rb, 1.21810e-02_rb, 1.19763e-02_rb, 1.17766e-02_rb, &
2626	1.15817e-02_rb, 1.13915e-02_rb, 1.12058e-02_rb/)
2627	absliq1(:,15) = (/ &
2628	! band 15
2629	5.02079e-03_rb, 2.17615e-02_rb, 2.55449e-02_rb, 2.59484e-02_rb, 2.53650e-02_rb, &
2630	2.45281e-02_rb, 2.36843e-02_rb, 2.29159e-02_rb, 2.22451e-02_rb, 2.16716e-02_rb, &
2631	2.11451e-02_rb, 2.05817e-02_rb, 2.00454e-02_rb, 1.95372e-02_rb, 1.90567e-02_rb, &
2632	1.86028e-02_rb, 1.81742e-02_rb, 1.77693e-02_rb, 1.73866e-02_rb, 1.70244e-02_rb, &
2633	1.66815e-02_rb, 1.63563e-02_rb, 1.60477e-02_rb, 1.57544e-02_rb, 1.54755e-02_rb, &
2634	1.52097e-02_rb, 1.49564e-02_rb, 1.47146e-02_rb, 1.43684e-02_rb, 1.41728e-02_rb, &
2635	1.39762e-02_rb, 1.37797e-02_rb, 1.35838e-02_rb, 1.33891e-02_rb, 1.31961e-02_rb, &
2636	1.30051e-02_rb, 1.28164e-02_rb, 1.26302e-02_rb, 1.24466e-02_rb, 1.22659e-02_rb, &
2637	1.20881e-02_rb, 1.19131e-02_rb, 1.17412e-02_rb, 1.15723e-02_rb, 1.14063e-02_rb, &
2638	1.12434e-02_rb, 1.10834e-02_rb, 1.09264e-02_rb, 1.07722e-02_rb, 1.06210e-02_rb, &
2639	1.04725e-02_rb, 1.03269e-02_rb, 1.01839e-02_rb, 1.00436e-02_rb, 9.90593e-03_rb, &
2640	9.77080e-03_rb, 9.63818e-03_rb, 9.50800e-03_rb/)
2641	absliq1(:,16) = (/ &
2642	! band 16
2643	5.64971e-02_rb, 9.04736e-02_rb, 8.11726e-02_rb, 7.05450e-02_rb, 6.20052e-02_rb, &
2644	5.54286e-02_rb, 5.03503e-02_rb, 4.63791e-02_rb, 4.32290e-02_rb, 4.06959e-02_rb, &
2645	3.74690e-02_rb, 3.52964e-02_rb, 3.33799e-02_rb, 3.16774e-02_rb, 3.01550e-02_rb, &
2646	2.87856e-02_rb, 2.75474e-02_rb, 2.64223e-02_rb, 2.53953e-02_rb, 2.44542e-02_rb, &
2647	2.35885e-02_rb, 2.27894e-02_rb, 2.20494e-02_rb, 2.13622e-02_rb, 2.07222e-02_rb, &
2648	2.01246e-02_rb, 1.95654e-02_rb, 1.90408e-02_rb, 1.84398e-02_rb, 1.80021e-02_rb, &
2649	1.75816e-02_rb, 1.71775e-02_rb, 1.67889e-02_rb, 1.64152e-02_rb, 1.60554e-02_rb, &
2650	1.57089e-02_rb, 1.53751e-02_rb, 1.50531e-02_rb, 1.47426e-02_rb, 1.44428e-02_rb, &
2651	1.41532e-02_rb, 1.38734e-02_rb, 1.36028e-02_rb, 1.33410e-02_rb, 1.30875e-02_rb, &
2652	1.28420e-02_rb, 1.26041e-02_rb, 1.23735e-02_rb, 1.21497e-02_rb, 1.19325e-02_rb, &
2653	1.17216e-02_rb, 1.15168e-02_rb, 1.13177e-02_rb, 1.11241e-02_rb, 1.09358e-02_rb, &
2654	1.07525e-02_rb, 1.05741e-02_rb, 1.04003e-02_rb/)
2655
2656	end subroutine lwcldpr
2657
2658	end module rrtmg_lw_init
2659

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: palm/trunk/LIB/rrtmg/rrtmg_lw_init.f90 @ 3359

Download in other formats: