source: palm/tags/release-5.0/LIB/rrtmg/rrtmg_lw_init.f90 @ 2977

Last change on this file since 2977 was 1585, checked in by maronga, 9 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.*planck*clight*clight*1.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=16*16, ngn=256*1., 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.