!MODULE module_ra_rrtmg_lwf
#define CHNK 8
!#define CHNK 1849
!#define CHNK 43

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2013, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! Uncomment to use GPU, or comment to use CPU
!#define _ACCEL

#ifdef _ACCEL
#define _gpudev  ,device
#define _gpudeva ,device,allocatable
#define _gpudevanp ,device,allocatable
#define _gpucon  ,constant
#define _gpuker  attributes(global)
#define _gpuked  attributes(device)
#define _gpuchv  <<<dimGrid,dimBlock>>>
#define _cpus    
#define _cpusnp
#else
#define _gpudev
#define _gpudeva ,pointer
#define _gpudevanp ,allocatable
#define _gpucon
#define _gpuker
#define _gpuked
#define _gpuchv
#define _cpus    ,target
#define _cpusnp  
#endif

#ifdef _ACCEL
#define dbreg(x) call dbal(x)
#define dbcop(x,y) call dbcp(x, cpointer);call c_f_pointer( cpointer, y, shape(x)) 
#define dbcopnp(x,y,t,u) call dbcp(x, cpointer);call c_f_pointer( cpointer, y, shape(x)) 
#define dreg(x,y,z) call ddbxeg(x,y,z,cpointer);call c_f_pointer( cpointer, x, [y,z] )
#define sreg(x,y,z) call ddbxeg(x,y,z,cpointer)
#define dbflushreg() call dbflushrg()
#define dbflushcop() call dbflushcp()
#else
#define dbreg(x) 
#define dbcop(x,y) y=>x
#define dbcopnp(x,y,u,v) if (allocated(y).eqv..true.) deallocate(y) ;allocate( y( u, v)); y=x
#define dbflushreg() 
#define dbflushcop() 
#define dreg(x,y,z) if (allocated(x).eqv..true.) deallocate(x) ;allocate( x( y , z))
#define sreg(x,y,z)
#endif

!! !#define _memdiag


module memory 17,14
#ifdef _ACCEL


use iso_c_binding
use cudafor
type adr
    integer*8 :: loc
    integer*8 :: size 
    integer*8 :: gap
    integer :: cindex = 0
    integer :: cnum = 0
    integer :: oindex = 0
    integer :: agn = 0
    type(c_ptr) :: locp
end type

type adrd
    type(c_devptr) :: loc
    integer*8 :: size
    real, device, allocatable :: ar(:)
end type


type(adr) :: plist(500)
type(adr) :: clist(100)
type(adrd) :: dlist(100)
integer :: np = 0
integer :: nc = 0
integer :: acgap = 4
type(c_devptr) :: cpointer

integer :: ddnp = 0
real, device, allocatable :: ddar(:)
real, device :: ddtemp(1)
integer :: ddsizec = 0
integer :: ddindex = 0
integer :: ddflush = 0




interface dbal 1
    module procedure dbalr, dbalr2, dbalr3, dbali, dbali2, dbali3
end interface 


interface dbcp 2
    module procedure dbcpi1, dbcpi2, dbcpi3, dbcpr1, dbcpr2, dbcpr3
end interface 


interface ddbxeg 2
    module procedure ddbxegi, ddbxegr
end interface

contains


subroutine ddbxegi( a, x, y , pt) 1
    integer, allocatable, device :: a(:,:)
    integer :: x,y
    type(c_devptr), intent(out) :: pt
    

    if (ddflush == 0) then
        
        ddsizec = ddsizec + (x*y)
        !pt = c_devloc( ddtemp(1) )

    else
        
        pt = c_devloc( ddar( ddindex ) )
        ddindex = ddindex + (x*y)
       
    end if
end subroutine




subroutine ddbxegr( a, x, y , pt) 1
    real, allocatable, device :: a(:,:)
    integer :: x,y
    type(c_devptr), intent(out) :: pt
    

    if (ddflush == 0) then
        
        ddsizec = ddsizec + (x*y)
        pt = c_devloc( ddtemp(1) )

    else
        
        pt = c_devloc( ddar( ddindex ) )
        ddindex = ddindex + (x*y)
       
    end if
end subroutine


subroutine dflush() 1
#ifdef _ACCEL
    allocate( ddar( ddsizec + 1 ) )
#endif
    
    ddflush = 1
    ddindex = 1
end subroutine


subroutine dclean() 1
#ifdef _ACCEL
    deallocate( ddar )
#endif
    ddindex = 0
    ddsizec = 0
    ddflush = 0
end subroutine

    

subroutine dbgenr( p, s ) 3
    real, intent(in) :: p(*)
    integer, intent(in) :: s
    np = np + 1
    plist(np)%loc = loc(p(1))
    plist(np)%locp = c_loc(p(1))
    plist(np)%size = s
    plist(np)%gap = 0
    plist(np)%oindex = np
#ifdef _memdiag
    print *, "index ", np
    print *, "real allocation ", np, " loc: ", plist(np)%loc, " size: ", plist(np)%size
#endif
end subroutine


subroutine dbgeni( p, s ) 3
    integer, intent(in) :: p(*)
    integer, intent(in) :: s
    np = np + 1
    plist(np)%loc = loc(p(1))
    plist(np)%locp = c_loc(p(1))
    plist(np)%size = s
    plist(np)%gap = 0
    plist(np)%oindex = np
#ifdef _memdiag
    print *, "index ", np   
    print *, "integer allocation ", np, " loc: ", plist(np)%loc, " size: ", plist(np)%size
#endif
end subroutine


subroutine dbalr( p ) 1,1
    real, intent(in) :: p(:)
    call dbgenr( p, size(p) * 4)
end subroutine


subroutine dbalr2( p) 1,1
    real, intent(in) :: p(:,:)
    call dbgenr( p, size(p) * 4)
end subroutine


subroutine dbalr3( p) 1,1
    real, intent(in) :: p(:,:,:)
    call dbgenr( p, size(p) * 4)
end subroutine


subroutine dbali( p ) 1,1
    integer, intent(in) :: p(:)
    call dbgeni( p, size(p) * 4)
end subroutine


subroutine dbali2( p ) 1,1
    integer, intent(in) :: p(:,:)
    call dbgeni( p, size(p) * 4)
end subroutine


subroutine dbali3( p ) 1,1
    integer, intent(in) :: p(:,:,:)
    call dbgeni( p, size(p) * 4)
end subroutine



subroutine dbflushrg() 1
    integer :: i,j
    integer*8 :: loc, size, oin
    type(c_ptr) :: locp, cpt
    integer :: cpti
#ifdef _memdiag
    print *, "analyzing memory"
    print *, "sorting entries"
#endif
    do j = 1, np
        do i = 1, np-1

            if (plist(i)%loc > plist(i+1)%loc) then
                loc = plist(i)%loc
                locp = plist(i)%locp
                size = plist(i)%size
                oin = plist(i)%oindex

                plist(i)%loc = plist(i+1)%loc
                plist(i)%locp = plist(i+1)%locp
                plist(i)%size = plist(i+1)%size
                plist(i)%oindex = plist(i+1)%oindex
                plist(i+1)%loc = loc
                plist(i+1)%locp = locp
                plist(i+1)%size = size
                plist(i+1)%oindex = oin
            end if

        end do
    end do

    do i = 1, np - 1
        plist(i)%gap = plist(i+1)%loc - (plist(i)%loc + plist(i)%size)
    end do
    plist(np)%gap = 9999999
#ifdef _memdiag
    print *, "sorted elements"
#endif    
    do i = 1, np 
#ifdef _memdiag
        print *, plist(i)%loc, plist(i)%size, plist(i)%gap
#endif
        if (plist(i)%gap < 0) then
            print *, "ERROR! Memory overlap found at index ", plist(i)%oindex
            stop
        end if
    end do
#ifdef _memdiag
    print *, "analyzing contiguous regions"
#endif
    nc = 1
    clist(1)%loc = plist(1)%loc
    clist(1)%cindex = 1
    do i = 1, np
        plist(i)%cnum = nc
        plist(i)%cindex = clist(nc)%size/4 

        if (plist(i)%gap > acgap) then
            clist(nc)%size = clist(nc)%size + plist(i)%size
            if (i < np) then
                clist(nc+1)%loc = plist(i+1)%loc
                clist(nc+1)%cindex = i+1
            end if
            nc = nc + 1
        else
            clist(nc)%size = clist(nc)%size + plist(i)%size + plist(i)%gap
        end if        

    end do
    nc = nc - 1

#ifdef _memdiag
    print *, "contiguous regions", nc
    print *, "number alloc/copy reduced to ", 100.0 * real(nc)/real(np), "%"

    do i = 1, nc 
        print *, clist(i)%loc, clist(i)%size
    end do

    print *, "allocating device memory"
#endif
    do i = 1, nc
        
        dlist(i)%size = clist(i)%size
#ifdef _memdiag        
        print *, dlist(i)%size
#endif
#ifdef _ACCEL
        allocate( dlist(i)%ar( dlist(i)%size + 2 ))
#endif
        dlist(i)%loc = c_devloc( dlist(i)%ar(1) )
    end do

   

end subroutine


subroutine dbcpr( p, pt )
    
    real, intent(in) :: p(*)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt


end subroutine


subroutine dbcpi1( p, pt ) 1,1
    integer, intent(in) :: p(:)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt
    lc = loc(p(1))
    call dbcpg( lc, pt)
end subroutine


subroutine dbcpi2( p, pt ) 1,1
    integer, intent(in) :: p(:,:)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt
    lc = loc(p(1,1))
    call dbcpg( lc, pt)
end subroutine


subroutine dbcpi3( p, pt ) 1,1
    integer, intent(in) :: p(:,:,:)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt
    lc = loc(p(1,1,1))
    call dbcpg( lc, pt)
end subroutine


subroutine dbcpr1( p, pt ) 1,1
    real, intent(in) :: p(:)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt
    lc = loc(p(1))
    call dbcpg( lc, pt)
end subroutine


subroutine dbcpr2( p, pt ) 1,1
    real, intent(in) :: p(:,:)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt
    lc = loc(p(1,1))
    call dbcpg( lc, pt)
end subroutine


subroutine dbcpr3( p, pt ) 1,1
    real, intent(in) :: p(:,:,:)
    integer*8 :: lc
    type(c_devptr), intent(out) :: pt
    lc = loc(p(1,1,1))
    call dbcpg( lc, pt)
end subroutine




subroutine dbcpg( lc, pt ) 6
    integer*8, intent(in) :: lc
    type(c_devptr), intent(out) :: pt
    integer :: fl
    fl = 0
    do i = 1, np

        if (plist(i)%loc .eq. lc) then
#ifdef _memdiag
            print *, "pointer found at index ", i
#endif
            pt = c_devloc( dlist( plist(i)%cnum )%ar( plist(i)%cindex+1 )) 
            fl = 1
            plist(i)%agn = 1
        end if
    end do

    if (fl == 0) then
        print *, "ERROR! pointer not found!"
        stop
    end if

end subroutine



subroutine dbflushcp 1
    integer :: i
    integer :: err
#ifdef _memdiag   
    print  *, "checking that all pointers are assigned"
#endif
    do i = 1, np
        if (plist(i)%agn == 0) then
            print *, "ERROR! pointer not assigned at index ", plist(i)%oindex
            stop
        end if
    end do
#ifdef _memdiag
    print *, "pointers are OK"
#endif
    do i=1, nc
        err = cudaMemCpyAsync( dlist(i)%loc, plist(clist(i)%cindex)%locp , clist(i)%size+1)
        if (err <> 0) then
            print *, "ERROR! there was an error with a memory copy"
            stop
        end if
    end do
#ifdef _memdiag
    print *, "memory copied successfully"
#endif
end subroutine


subroutine dbclean 1
    integer :: i
   
    do i=1, nc
        dlist(i)%size=0
        clist(i)%size=0

#ifdef _ACCEL
        deallocate( dlist(i)%ar )
#endif
    end do
    nc = 0
    np = 0

end subroutine
#endif
end module




      module parrrtm_f 44

!     use parkind ,only : im => kind 

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_lw main parameters
!
! Initial version:  JJMorcrette, ECMWF, Jul 1998
! Revised: MJIacono, AER, Jun 2006
! Revised: MJIacono, AER, Aug 2007
! Revised: MJIacono, AER, Aug 2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! mxlay  :  integer: maximum number of layers
! mg     :  integer: number of original g-intervals per spectral band
! nbndlw :  integer: number of spectral bands
! maxxsec:  integer: maximum number of cross-section molecules
!                    (e.g. cfcs)
! maxinpx:  integer: 
! ngptlw :  integer: total number of reduced g-intervals for rrtmg_lw
! ngNN   :  integer: number of reduced g-intervals per spectral band
! ngsNN  :  integer: cumulative number of g-intervals per band
!------------------------------------------------------------------

      integer , parameter :: mxlay  = 100
      integer , parameter :: mg     = 16
      integer , parameter :: nbndlw = 16
      integer , parameter :: maxxsec= 4
      integer , parameter :: mxmol  = 38
      integer , parameter :: maxinpx= 38
      integer , parameter :: nmol   = 7
! Use for 140 g-point model 
      integer , parameter :: ngptlw = 140
! Use for 256 g-point model 
!      integer , parameter :: ngptlw = 256

! Use for 140 g-point model
      integer , parameter :: ng1  = 10
      integer , parameter :: ng2  = 12
      integer , parameter :: ng3  = 16
      integer , parameter :: ng4  = 14
      integer , parameter :: ng5  = 16
      integer , parameter :: ng6  = 8
      integer , parameter :: ng7  = 12
      integer , parameter :: ng8  = 8
      integer , parameter :: ng9  = 12
      integer , parameter :: ng10 = 6
      integer , parameter :: ng11 = 8
      integer , parameter :: ng12 = 8
      integer , parameter :: ng13 = 4
      integer , parameter :: ng14 = 2
      integer , parameter :: ng15 = 2
      integer , parameter :: ng16 = 2

      integer , parameter :: ngs1  = 10
      integer , parameter :: ngs2  = 22
      integer , parameter :: ngs3  = 38
      integer , parameter :: ngs4  = 52
      integer , parameter :: ngs5  = 68
      integer , parameter :: ngs6  = 76
      integer , parameter :: ngs7  = 88
      integer , parameter :: ngs8  = 96
      integer , parameter :: ngs9  = 108
      integer , parameter :: ngs10 = 114
      integer , parameter :: ngs11 = 122
      integer , parameter :: ngs12 = 130
      integer , parameter :: ngs13 = 134
      integer , parameter :: ngs14 = 136
      integer , parameter :: ngs15 = 138

! Use for 256 g-point model
!      integer , parameter :: ng1  = 16
!      integer , parameter :: ng2  = 16
!      integer , parameter :: ng3  = 16
!      integer , parameter :: ng4  = 16
!      integer , parameter :: ng5  = 16
!      integer , parameter :: ng6  = 16
!      integer , parameter :: ng7  = 16
!      integer , parameter :: ng8  = 16
!      integer , parameter :: ng9  = 16
!      integer , parameter :: ng10 = 16
!      integer , parameter :: ng11 = 16
!      integer , parameter :: ng12 = 16
!      integer , parameter :: ng13 = 16
!      integer , parameter :: ng14 = 16
!      integer , parameter :: ng15 = 16
!      integer , parameter :: ng16 = 16

!      integer , parameter :: ngs1  = 16
!      integer , parameter :: ngs2  = 32
!      integer , parameter :: ngs3  = 48
!      integer , parameter :: ngs4  = 64
!      integer , parameter :: ngs5  = 80
!      integer , parameter :: ngs6  = 96
!      integer , parameter :: ngs7  = 112
!      integer , parameter :: ngs8  = 128
!      integer , parameter :: ngs9  = 144
!      integer , parameter :: ngs10 = 160
!      integer , parameter :: ngs11 = 176
!      integer , parameter :: ngs12 = 192
!      integer , parameter :: ngs13 = 208
!      integer , parameter :: ngs14 = 224
!      integer , parameter :: ngs15 = 240
!      integer , parameter :: ngs16 = 256

      end module parrrtm_f


      module rrlw_cld_f 3

!     use parkind, only : rb => kind 

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_lw cloud property coefficients

! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! abscld1:  real   : 
! absice0:  real   : 
! absice1:  real   : 
! absice2:  real   : 
! absice3:  real   : 
! absliq0:  real   : 
! absliq1:  real   : 
!------------------------------------------------------------------

      real  :: abscld1
      real  , dimension(2) :: absice0
      real  , dimension(2,5) :: absice1
      real  , dimension(43,16) :: absice2
      real  , dimension(46,16) :: absice3
      real :: absliq0
      real  , dimension(58,16) :: absliq1

      end module rrlw_cld_f


      module rrlw_con_f 7

!     use parkind, only : rb => kind 

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_lw constants

! Initial version: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! fluxfac:  real   : radiance to flux conversion factor 
! heatfac:  real   : flux to heating rate conversion factor
!oneminus:  real   : 1.-1.e-6
! pi     :  real   : pi
! grav   :  real   : acceleration of gravity
! planck :  real   : planck constant
! boltz  :  real   : boltzmann constant
! clight :  real   : speed of light
! avogad :  real   : avogadro constant 
! alosmt :  real   : loschmidt constant
! gascon :  real   : molar gas constant
! radcn1 :  real   : first radiation constant
! radcn2 :  real   : second radiation constant
! sbcnst :  real   : stefan-boltzmann constant
!  secdy :  real   : seconds per day  
!------------------------------------------------------------------

      real  :: fluxfac, heatfac
      real  :: oneminus, pi, grav
      real  :: planck, boltz, clight
      real  :: avogad, alosmt, gascon
      real  :: radcn1, radcn2
      real  :: sbcnst, secdy

      end module rrlw_con_f


      module rrlw_kg01_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 1
! band 1:  10-250 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real
! kao     : real     
! kbo     : real     
! kao_mn2 : real     
! kbo_mn2 : real     
! selfrefo: real     
! forrefo : real
!-----------------------------------------------------------------

      integer , parameter :: no1  = 16

      real  :: fracrefao(no1)  , fracrefbo(no1)
      real  :: kao(5,13,no1)
      real  :: kbo(5,13:59,no1)
      real  :: kao_mn2(19,no1) , kbo_mn2(19,no1)
      real  :: selfrefo(10,no1), forrefo(4,no1)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 1
! band 1:  10-250 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! ka_mn2  : real     
! kb_mn2  : real     
! selfref : real     
! forref  : real
!-----------------------------------------------------------------

      integer , parameter :: ng1  = 10

      
      real  _cpusnp :: ka(5,13,ng1)   , absa(65,ng1)
      real  _cpusnp :: kb(5,13:59,ng1), absb(235,ng1)
      real  _cpus :: fracrefa(ng1)  , fracrefb(ng1)
      real  _cpus :: ka_mn2(19,ng1) , kb_mn2(19,ng1)
      real  _cpus :: selfref(10,ng1), forref(4,ng1)

      
      real  _gpudevanp :: kad(:,:,:), absad(:,:), absbd(:,:)
      real  _gpudevanp :: kbd(:,:,:)
      
      real  _gpudeva :: fracrefad(:)  , fracrefbd(:)
      real  _gpudeva :: ka_mn2d(:,:) , kb_mn2d(:,:)
      real  _gpudeva :: selfrefd(:,:), forrefd(:,:)

      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))

      contains


      subroutine copyToGPU1 1
     
        dbcop(fracrefa,fracrefad)
        dbcop(fracrefb,fracrefbd)
        dbcop(ka_mn2,ka_mn2d)
        dbcop(kb_mn2,kb_mn2d)
        dbcop(selfref,selfrefd)
        dbcop(forref,forrefd)

        dbcopnp(absa , absad , 65 , ng1)
        dbcopnp(absb , absbd , 235 , ng1)
     
      end subroutine 


      subroutine reg1 1

        dbreg(fracrefa)
        dbreg(fracrefb)
        dbreg(ka_mn2)
        dbreg(kb_mn2)
        dbreg(selfref)
        dbreg(forref)
        dbreg(absa)
        dbreg(absb)
        
      end subroutine 

      end module rrlw_kg01_f


      module rrlw_kg02_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 2
! band 2:  250-500 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!-----------------------------------------------------------------

      integer , parameter :: no2  = 16
      real  _cpus :: kao(5,13,no2)
      real  _cpus :: kbo(5,13:59,no2)
      real  _cpus :: fracrefao(no2)   , fracrefbo(no2)
      real  _cpus :: selfrefo(10,no2) , forrefo(4,no2)

      real  _gpudeva :: fracrefaod(:)   , fracrefbod(:)
      real  _gpudeva :: selfrefod(:,:) , forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 2
! band 2:  250-500 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
!
! refparam: real
!-----------------------------------------------------------------

      integer , parameter :: ng2  = 12

      real  _cpus :: fracrefa(ng2)  , fracrefb(ng2)
      real  _cpusnp :: ka(5,13,ng2)   , absa(65,ng2)
      real  _cpusnp :: kb(5,13:59,ng2), absb(235,ng2)
      real  _cpus :: selfref(10,ng2), forref(4,ng2)

      real  _gpudeva :: fracrefad(:)  , fracrefbd(:)
      real  _gpudevanp :: absad(:,:)
      real  _gpudevanp :: absbd(:,:)
      real  _gpudeva :: selfrefd(:,:), forrefd(:,:)

      real  :: refparam(13)

      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))

      contains
      

      subroutine copyToGPU2 1

        dbcop(fracrefao,fracrefaod)
        dbcop(fracrefbo,fracrefbod)       
        dbcop(selfrefo, selfrefod)
        dbcop(forrefo, forrefod)

        dbcop(fracrefa,fracrefad)
        dbcop(fracrefb,fracrefbd)       

        dbcopnp(absa , absad , 65 , ng2)
        dbcopnp(absb , absbd , 235 , ng2)

        dbcop(selfref, selfrefd)
        dbcop(forref, forrefd)
        
      end subroutine 
        

      subroutine reg2 1
         ! 9
        dbreg(fracrefao)
        dbreg(fracrefbo)        
        dbreg(selfrefo)
        dbreg(forrefo)
         
        dbreg(fracrefa)
        dbreg(fracrefb)        
        dbreg(absa)        
        dbreg(absb)
        dbreg(selfref)
        dbreg(forref)

      end subroutine

      end module rrlw_kg02_f


      module rrlw_kg03_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 3
! band 3:  500-630 cm-1 (low - h2o,co2; high - h2o,co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real
! kao     : real     
! kbo     : real     
! kao_mn2o: real     
! kbo_mn2o: real     
! selfrefo: real     
! forrefo : real
!-----------------------------------------------------------------

      integer , parameter :: no3  = 16

      real  _cpus :: fracrefao(no3,9) ,fracrefbo(no3,5)
      real  _cpus :: kao(9,5,13,no3)
      real  _cpus :: kbo(5,5,13:59,no3)
      real  _cpus :: kao_mn2o(9,19,no3), kbo_mn2o(5,19,no3)
      real  _cpus :: selfrefo(10,no3)
      real  _cpus :: forrefo(4,no3)

      real  _gpudeva :: fracrefaod(:,:) ,fracrefbod(:,:)
      !real  _gpudeva :: kaod(9,5,13,no3)
      !real  _gpudeva :: kbod(5,5,13:59,no3)
      real  _gpudeva :: kao_mn2od(:,:,:), kbo_mn2od(:,:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 3
! band 3:  500-630 cm-1 (low - h2o,co2; high - h2o,co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real
! ka      : real     
! kb      : real     
! ka_mn2o : real     
! kb_mn2o : real     
! selfref : real     
! forref  : real
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng3  = 16

      real  _cpus :: fracrefa(ng3,9) ,fracrefb(ng3,5)
      real  _cpusnp :: ka(9,5,13,ng3)  ,absa(585,ng3)
      real  _cpusnp :: kb(5,5,13:59,ng3),absb(1175,ng3)
      real  _cpus :: ka_mn2o(9,19,ng3), kb_mn2o(5,19,ng3)
      real  _cpus :: selfref(10,ng3)
      real  _cpus :: forref(4,ng3)

      real  _gpudeva :: fracrefad(:,:) ,fracrefbd(:,:)
      real  _gpudevanp :: absad(:,:)
      real  _gpudevanp :: absbd(:,:)
      real  _gpudeva :: ka_mn2od(:,:,:), kb_mn2od(:,:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU3 1

       dbcop( fracrefao , fracrefaod )
       dbcop( fracrefbo , fracrefbod )
       dbcop( kao_mn2o , kao_mn2od )
       dbcop( kbo_mn2o , kbo_mn2od )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )
   
       dbcopnp( absa , absad , 585 , ng3 )
       dbcopnp( absb , absbd , 1175 , ng3 )

       dbcop( ka_mn2o , ka_mn2od )
       dbcop( kb_mn2o , kb_mn2od )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg3 1
       !19
       dbreg( fracrefao )
       dbreg( fracrefbo )
     
       dbreg( kao_mn2o )
       dbreg( kbo_mn2o )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       dbreg( fracrefb )
      
       dbreg( absa )
     
       dbreg( absb )
       dbreg( ka_mn2o )
       dbreg( kb_mn2o )
       dbreg( selfref )
       dbreg( forref )

      end subroutine

      end module rrlw_kg03_f


      module rrlw_kg04_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 4
! band 4:  630-700 cm-1 (low - h2o,co2; high - o3,co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------
      integer , parameter :: ng4  = 14
      integer , parameter :: no4  = 16

      real  _cpus :: kao(9,5,13,no4)
      real  _cpus :: kbo(5,5,13:59,no4)
      real  _cpusnp :: ka(9,5,13,ng4)   ,absa(585,ng4)
      real  _cpusnp :: kb(5,5,13:59,ng4),absb(1175,ng4)

      real  _cpus :: fracrefao(no4,9)  ,fracrefbo(no4,5)
 
      real  _cpus :: selfrefo(10,no4)  ,forrefo(4,no4)

      real  _gpudeva :: fracrefaod(:,:)  ,fracrefbod(:,:)
      !real  _gpudev :: kaod(9,5,13,no4)
      !real  _gpudev :: kbod(5,5,13:59,no4)
      real  _gpudeva :: selfrefod(:,:)  ,forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 4
! band 4:  630-700 cm-1 (low - h2o,co2; high - o3,co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! absa    : real
! absb    : real
!fracrefa : real    
!fracrefb : real
! ka      : real     
! kb      : real     
! selfref : real     
! forref  : real     
!-----------------------------------------------------------------

      real  _cpus :: fracrefa(ng4,9)  ,fracrefb(ng4,5)
      
      real  _cpus :: selfref(10,ng4)  ,forref(4,ng4)

      real  _gpudeva :: fracrefad(:,:)  ,fracrefbd(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudevanp ::  absbd(:,:)
      real  _gpudeva :: selfrefd(:,:)  ,forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU4 1

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )
      
       dbcopnp( absa , absad , 585 , ng4 )
       dbcopnp( absb , absbd , 1175 , ng4)

       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg4 1
       !33
       dbreg( fracrefa )
       dbreg( fracrefb )
    
       dbreg( absa )

       dbreg( absb )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg04_f


      module rrlw_kg05_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 5
! band 5:  700-820 cm-1 (low - h2o,co2; high - o3,co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real
! kao     : real     
! kbo     : real     
! kao_mo3 : real     
! selfrefo: real     
! forrefo : real     
! ccl4o   : real
!-----------------------------------------------------------------

      integer , parameter :: no5  = 16
      integer , parameter :: ng5  = 16
      real  _cpusnp :: ka(9,5,13,ng5),kb(5,5,13:59,ng5)  
      real  _cpus :: kao(9,5,13,no5)
      real  _cpus :: kbo(5,5,13:59,no5)

      real  _cpus :: fracrefao(no5,9) ,fracrefbo(no5,5) 
      real  _cpusnp :: absa(585,ng5)
 
      real  _cpus :: kao_mo3(9,19,no5)
      real  _cpus :: selfrefo(10,no5)
      real  _cpus :: forrefo(4,no5)
      real  _cpus :: ccl4o(no5)


      real  _gpudeva :: fracrefaod(:,:) ,fracrefbod(:,:)
      real  _gpudev :: kaod(9,5,13,no5)
      real  _gpudev :: kbod(5,5,13:59,no5)
      real  _gpudeva :: kao_mo3d(:,:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)
      real  _gpudeva :: ccl4od(:)
!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 5
! band 5:  700-820 cm-1 (low - h2o,co2; high - o3,co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real
! ka      : real     
! kb      : real     
! ka_mo3  : real     
! selfref : real     
! forref  : real     
! ccl4    : real
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      real  _cpusnp :: absb(1175,ng5)

      real  _cpus :: fracrefa(ng5,9) ,fracrefb(ng5,5)
      
      real  _cpus :: ka_mo3(9,19,ng5)
      real  _cpus :: selfref(10,ng5)
      real  _cpus :: forref(4,ng5)
      real  _cpus :: ccl4(ng5)

      real  _gpudeva :: fracrefad(:,:) ,fracrefbd(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudevanp ::  absbd(:,:)
      real  _gpudeva :: ka_mo3d(:,:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)
      real  _gpudeva :: ccl4d(:)
      
      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU5 1

       dbcop( fracrefao , fracrefaod )
       dbcop( fracrefbo , fracrefbod )
    
       dbcop( kao_mo3 , kao_mo3d )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )
       dbcop( ccl4o , ccl4od )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )

       dbcopnp( absa , absad, 585 , ng5 )
       dbcopnp( absb , absbd, 1175 , ng5 )

       dbcop( ka_mo3 , ka_mo3d )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )
       dbcop( ccl4 , ccl4d )

      end subroutine 


      subroutine reg5 1
    
       dbreg( fracrefao )
       dbreg( fracrefbo )
     
       dbreg( kao_mo3 )
       dbreg( selfrefo )
       dbreg( forrefo )
       dbreg( ccl4o )

       dbreg( fracrefa )
       dbreg( fracrefb )
      
       dbreg( absa )
     
       dbreg( absb )
       dbreg( ka_mo3 )
       dbreg( selfref )
       dbreg( forref )
       dbreg( ccl4 )

      end subroutine 

      end module rrlw_kg05_f


      module rrlw_kg06_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 6
! band 6:  820-980 cm-1 (low - h2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
! kao     : real     
! kao_mco2: real     
! selfrefo: real     
! forrefo : real     
!cfc11adjo: real
! cfc12o  : real
!-----------------------------------------------------------------

      integer , parameter :: no6  = 16
      integer , parameter :: ng6  = 8

      real  _cpusnp :: ka(5,13,ng6),absa(65,ng6)
      real  _cpus, dimension(no6) :: fracrefao
      real  _cpus :: kao(5,13,no6)
      real  _cpus :: kao_mco2(19,no6)
      real  _cpus :: selfrefo(10,no6)
      real  _cpus :: forrefo(4,no6)

      real  _cpus, dimension(no6) :: cfc11adjo
      real  _cpus, dimension(no6) :: cfc12o

      real  _gpudeva , dimension(:) :: fracrefaod
      real  _gpudeva :: kaod(:,:,:)
      real  _gpudeva :: kao_mco2d(:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

      real  _gpudeva , dimension(:) :: cfc11adjod
      real  _gpudeva , dimension(:) :: cfc12od

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 6
! band 6:  820-980 cm-1 (low - h2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
! ka      : real     
! ka_mco2 : real     
! selfref : real     
! forref  : real     
!cfc11adj : real
! cfc12   : real
!
! absa    : real
!-----------------------------------------------------------------

      real  _cpus, dimension(ng6) :: fracrefa
      
      real  _cpus :: ka_mco2(19,ng6)
      real  _cpus :: selfref(10,ng6)
      real  _cpus :: forref(4,ng6)

      real  _cpus, dimension(ng6) :: cfc11adj
      real  _cpus, dimension(ng6) :: cfc12

      real  _gpudeva , dimension(:) :: fracrefad
      real  _gpudevanp :: absad(:,:)
      real  _gpudeva :: ka_mco2d(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      real  _gpudeva , dimension(:) :: cfc11adjd
      real  _gpudeva , dimension(:) :: cfc12d
      
      equivalence (ka(1,1,1),absa(1,1))

      contains 


      subroutine copyToGPU6 1

       dbcop( fracrefao , fracrefaod )    
       dbcop( kao , kaod )      
       dbcop( kao_mco2 , kao_mco2d )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )
       dbcop( cfc11adjo , cfc11adjod )
       dbcop( cfc12o , cfc12od )
      
       dbcop( fracrefa , fracrefad )
      
       dbcopnp( absa , absad, 65, ng6 )
       dbcop( ka_mco2 , ka_mco2d )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )
       dbcop( cfc11adj , cfc11adjd )
       dbcop( cfc12 , cfc12d )

      end subroutine 


      subroutine reg6 1
       !53
       dbreg( fracrefao )    
       dbreg( kao )      
       dbreg( kao_mco2 )
       dbreg( selfrefo )
       dbreg( forrefo )
       dbreg( cfc11adjo )
       dbreg( cfc12o )
      
       dbreg( fracrefa )
     
       dbreg( absa )
       dbreg( ka_mco2 )
       dbreg( selfref )
       dbreg( forref )
       dbreg( cfc11adj )
       dbreg( cfc12 )

      end subroutine 

      end module rrlw_kg06_f


      module rrlw_kg07_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 7
! band 7:  980-1080 cm-1 (low - h2o,o3; high - o3)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! kao_mco2: real     
! kbo_mco2: real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no7  = 16
      integer , parameter :: ng7  = 12
      real  _gpudev :: kaod(9,5,13,no7)
      real  _gpudev :: kbod(5,13:59,no7)
      real  _cpusnp :: ka(9,5,13,ng7) ,kb(5,13:59,ng7),absa(585,ng7)
      real  _cpusnp :: absb(235,ng7)

      real  _cpus, dimension(no7) :: fracrefbo
      real  _cpus :: fracrefao(no7,9)
      real  _cpus :: kao(9,5,13,no7)
      real  _cpus :: kbo(5,13:59,no7)
      real  _cpus :: kao_mco2(9,19,no7)
      real  _cpus :: kbo_mco2(19,no7)
      real  _cpus :: selfrefo(10,no7)
      real  _cpus :: forrefo(4,no7)

      real  _gpudeva , dimension(:) :: fracrefbod
      real  _gpudeva :: fracrefaod(:,:)
    
      real  _gpudeva :: kao_mco2d(:,:,:)
      real  _gpudeva :: kbo_mco2d(:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 7
! band 7:  980-1080 cm-1 (low - h2o,o3; high - o3)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real    
! ka      : real     
! kb      : real     
! ka_mco2 : real     
! kb_mco2 : real     
! selfref : real     
! forref  : real     
!
! absa    : real
!-----------------------------------------------------------------

      real  _cpus, dimension(ng7) :: fracrefb
      real  _cpus :: fracrefa(ng7,9)
      
      real  _cpus :: ka_mco2(9,19,ng7)
      real  _cpus :: kb_mco2(19,ng7)
      real  _cpus :: selfref(10,ng7)
      real  _cpus :: forref(4,ng7)

      real  _gpudeva , dimension(:) :: fracrefbd
      real  _gpudeva :: fracrefad(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudevanp ::  absbd(:,:)
      real  _gpudeva :: ka_mco2d(:,:,:)
      real  _gpudeva :: kb_mco2d(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)
      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))

      contains


      subroutine copyToGPU7 1

       dbcop( fracrefb , fracrefbd )    
       dbcop( fracrefa , fracrefad )
        
       dbcopnp( absa , absad, 585, ng7 )
       dbcopnp( absb , absbd, 235, ng7 )

       dbcop( ka_mco2 , ka_mco2d )
       dbcop( kb_mco2 , kb_mco2d )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

       dbcop( fracrefbo , fracrefbod )    
       dbcop( fracrefao , fracrefaod )
     
       dbcop( kao_mco2 , kao_mco2d )
       dbcop( kbo_mco2 , kbo_mco2d )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

      end subroutine 


      subroutine reg7 1
       !67
       dbreg( fracrefb )    
       dbreg( fracrefa )

       !dbreg( ka )      
       dbreg( absa )
       !dbreg( kb )
       dbreg( absb )
       dbreg( ka_mco2 )
       dbreg( kb_mco2 )
       dbreg( selfref )
       dbreg( forref )

       dbreg( fracrefbo )    
       dbreg( fracrefao )
       !dbreg( kao )      
       !dbreg( kbo )
       !dbreg( absbo )
       dbreg( kao_mco2 )
       dbreg( kbo_mco2 )
       dbreg( selfrefo )
       dbreg( forrefo )

      end subroutine 

      end module rrlw_kg07_f


      module rrlw_kg08_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 8
! band 8:  1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! kao_mco2: real     
! kbo_mco2: real     
! kao_mn2o: real     
! kbo_mn2o: real     
! kao_mo3 : real     
! selfrefo: real     
! forrefo : real     
! cfc12o  : real     
!cfc22adjo: real     
!-----------------------------------------------------------------

      integer , parameter :: no8  = 16

      real  _cpus, dimension(no8) :: fracrefao
      real  _cpus, dimension(no8) :: fracrefbo
      real  _cpus, dimension(no8) :: cfc12o
      real  _cpus, dimension(no8) :: cfc22adjo

      real  _cpus :: kao(5,13,no8)
      real  _cpus :: kao_mco2(19,no8)
      real  _cpus :: kao_mn2o(19,no8)
      real  _cpus :: kao_mo3(19,no8)
      real  _cpus :: kbo(5,13:59,no8)
      real  _cpus :: kbo_mco2(19,no8)
      real  _cpus :: kbo_mn2o(19,no8)
      real  _cpus :: selfrefo(10,no8)
      real  _cpus :: forrefo(4,no8)

      real  _gpudeva , dimension(:) :: fracrefaod
      real  _gpudeva , dimension(:) :: fracrefbod
      real  _gpudeva , dimension(:) :: cfc12od
      real  _gpudeva , dimension(:) :: cfc22adjod

      real  _gpudev :: kaod(5,13,no8)
      real  _gpudeva :: kao_mco2d(:,:)
      real  _gpudeva :: kao_mn2od(:,:)
      real  _gpudeva :: kao_mo3d(:,:)
      real  _gpudev :: kbod(5,13:59,no8)
      real  _gpudeva :: kbo_mco2d(:,:)
      real  _gpudeva :: kbo_mn2od(:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 8
! band 8:  1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real    
! ka      : real     
! kb      : real     
! ka_mco2 : real     
! kb_mco2 : real     
! ka_mn2o : real     
! kb_mn2o : real     
! ka_mo3  : real     
! selfref : real     
! forref  : real     
! cfc12   : real     
! cfc22adj: real     
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng8  = 8

      real  _cpus, dimension(ng8) :: fracrefa
      real  _cpus, dimension(ng8) :: fracrefb
      real  _cpus, dimension(ng8) :: cfc12
      real  _cpus, dimension(ng8) :: cfc22adj

      real  _cpusnp :: ka(5,13,ng8)    ,absa(65,ng8)
      real  _cpusnp :: kb(5,13:59,ng8) ,absb(235,ng8)
      real  _cpus :: ka_mco2(19,ng8)
      real  _cpus :: ka_mn2o(19,ng8)
      real  _cpus :: ka_mo3(19,ng8)
      real  _cpus :: kb_mco2(19,ng8)
      real  _cpus :: kb_mn2o(19,ng8)
      real  _cpus :: selfref(10,ng8)
      real  _cpus :: forref(4,ng8)

      real  _gpudeva  , dimension(:) :: fracrefad
      real  _gpudeva  , dimension(:) :: fracrefbd
      real  _gpudeva  , dimension(:) :: cfc12d
      real  _gpudeva  , dimension(:) :: cfc22adjd

      real  _gpudevanp  ::  absad(:,:)
      real  _gpudevanp  ::  absbd(:,:)
      real  _gpudeva  :: ka_mco2d(:,:)
      real  _gpudeva  :: ka_mn2od(:,:)
      real  _gpudeva  :: ka_mo3d(:,:)
      real  _gpudeva  :: kb_mco2d(:,:)
      real  _gpudeva  :: kb_mn2od(:,:)
      real  _gpudeva  :: selfrefd(:,:)
      real  _gpudeva  :: forrefd(:,:)

      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU8 1

       kaod = kao
       kbod = kbo

       dbcop( fracrefao , fracrefaod )
       dbcop( fracrefbo , fracrefbod )
       dbcop( cfc12o , cfc12od )
       dbcop( cfc22adjo , cfc22adjod )
   
       dbcop( kao_mco2 , kao_mco2d )
       dbcop( kao_mn2o , kao_mn2od )
       dbcop( kao_mo3 , kao_mo3d )
     
       dbcop( kbo_mco2 , kbo_mco2d )
       dbcop( kbo_mn2o , kbo_mn2od )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )
       dbcop( cfc12 , cfc12d )
       dbcop( cfc22adj , cfc22adjd )
    
       dbcopnp( absa , absad, 65 , ng8 )
       dbcopnp( absb , absbd, 235 , ng8 )

       dbcop( ka_mco2 , ka_mco2d )
       dbcop( ka_mn2o , ka_mn2od )
       dbcop( ka_mo3 , ka_mo3d )
       dbcop( kb_mco2 , kb_mco2d )
       dbcop( kb_mn2o , kb_mn2od )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 
 

      subroutine reg8 1
     
       dbreg( fracrefao )
       dbreg( fracrefbo )
       dbreg( cfc12o )
       dbreg( cfc22adjo )

       dbreg( kao_mco2 )
       dbreg( kao_mn2o )
       dbreg( kao_mo3 )

       dbreg( kbo_mco2 )
       dbreg( kbo_mn2o )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       dbreg( fracrefb )
       dbreg( cfc12 )
       dbreg( cfc22adj )
       dbreg( absa )
       dbreg( absb )
       dbreg( ka_mco2 )
       dbreg( ka_mn2o )
       dbreg( ka_mo3 )
       dbreg( kb_mco2 )
       dbreg( kb_mn2o )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg08_f


      module rrlw_kg09_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 9
! band 9:  1180-1390 cm-1 (low - h2o,ch4; high - ch4)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! kao_mn2o: real     
! kbo_mn2o: real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no9  = 16

      real  _cpus, dimension(no9) :: fracrefbo

      real  _cpus :: fracrefao(no9,9)
      real  _cpus :: kao(9,5,13,no9)
      real  _cpus :: kbo(5,13:59,no9)
      real  _cpus :: kao_mn2o(9,19,no9)
      real  _cpus :: kbo_mn2o(19,no9)
      real  _cpus :: selfrefo(10,no9)
      real  _cpus :: forrefo(4,no9)

      real  _gpudeva , dimension(:) :: fracrefbod

      real  _gpudeva :: fracrefaod(:,:)
      real  _gpudev :: kaod(9,5,13,no9)
      real  _gpudev :: kbod(5,13:59,no9)
      real  _gpudeva :: kao_mn2od(:,:,:)
      real  _gpudeva :: kbo_mn2od(:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 9
! band 9:  1180-1390 cm-1 (low - h2o,ch4; high - ch4)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real    
! ka      : real     
! kb      : real     
! ka_mn2o : real     
! kb_mn2o : real     
! selfref : real     
! forref  : real     
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng9  = 12

      real  _cpus, dimension(ng9) :: fracrefb
      real  _cpus :: fracrefa(ng9,9)
      real  _cpusnp :: ka(9,5,13,ng9) ,absa(585,ng9)
      real  _cpusnp :: kb(5,13:59,ng9) ,absb(235,ng9)
      real  _cpus :: ka_mn2o(9,19,ng9)
      real  _cpus :: kb_mn2o(19,ng9)
      real  _cpus :: selfref(10,ng9)
      real  _cpus :: forref(4,ng9)

      real  _gpudeva , dimension(:) :: fracrefbd
      real  _gpudeva :: fracrefad(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudevanp ::  absbd(:,:)
      real  _gpudeva :: ka_mn2od(:,:,:)
      real  _gpudeva :: kb_mn2od(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU9 1

       kaod = kao
       kbod = kbo

       dbcop( fracrefao , fracrefaod )
       dbcop( fracrefbo , fracrefbod )

       dbcopnp( absa , absad , 585 , ng9  )
       dbcopnp( absb , absbd, 235 , ng9 )

       dbcop( kao_mn2o , kao_mn2od )
       dbcop( kbo_mn2o , kbo_mn2od )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )

       dbcop( ka_mn2o , ka_mn2od )
       dbcop( kb_mn2o , kb_mn2od )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

      end subroutine 


      subroutine reg9 1

       !105
       dbreg( fracrefao )
       dbreg( fracrefbo )

       dbreg( kao_mn2o )
       dbreg( kbo_mn2o )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       dbreg( fracrefb )

       dbreg( absa )
       dbreg( absb )
       dbreg( ka_mn2o )
       dbreg( kb_mn2o )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg09_f


      module rrlw_kg10_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 10
! band 10:  1390-1480 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no10 = 16

      real  _cpus, dimension(no10) :: fracrefao
      real  _cpus, dimension(no10) :: fracrefbo

      real  _cpus :: kao(5,13,no10)
      real  _cpus :: kbo(5,13:59,no10)
      real  _cpus :: selfrefo(10,no10)
      real  _cpus :: forrefo(4,no10)

      real  _gpudeva , dimension(:) :: fracrefaod
      real  _gpudeva , dimension(:) :: fracrefbod

      real  _gpudev :: kaod(5,13,no10)
      real  _gpudev :: kbod(5,13:59,no10)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 10
! band 10:  1390-1480 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! selfref : real     
! forref  : real     
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng10 = 6

      real  _cpus , dimension(ng10) :: fracrefa
      real  _cpus , dimension(ng10) :: fracrefb

      real  _cpusnp :: ka(5,13,ng10)   , absa(65,ng10)
      real  _cpusnp :: kb(5,13:59,ng10), absb(235,ng10)
      real  _cpus :: selfref(10,ng10)
      real  _cpus :: forref(4,ng10)

      real  _gpudeva , dimension(:) :: fracrefad
      real  _gpudeva , dimension(:) :: fracrefbd

      real  _gpudevanp ::   absad(:,:)
      real  _gpudevanp ::   absbd(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)
      
      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU10 1

       kaod = kao
       kbod = kbo

       dbcop( fracrefao , fracrefaod )
       dbcop( fracrefbo , fracrefbod )

       !dbcop( kao , kaod ) 
       !dbcop( kbo , kbod )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )

       !dbcop( ka , kad ) 
       !dbcop( kb , kbd )
       dbcopnp( absa , absad, 65 , ng10 )
       dbcopnp( absb , absbd, 235 , ng10 )

       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg10 1

       dbreg( fracrefao )
       dbreg( fracrefbo )

       !dbreg( kao ) 
       !dbreg( kbo )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       dbreg( fracrefb )

       !dbreg( ka ) 
       !dbreg( kb )
       dbreg( absa )
       dbreg( absb )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg10_f


      module rrlw_kg11_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 11
! band 11:  1480-1800 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! kao_mo2 : real     
! kbo_mo2 : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no11 = 16

      real  _cpus, dimension(no11) :: fracrefao
      real  _cpus, dimension(no11) :: fracrefbo

      real  _cpus :: kao(5,13,no11)
      real  _cpus :: kbo(5,13:59,no11)
      real  _cpus :: kao_mo2(19,no11)
      real  _cpus :: kbo_mo2(19,no11)
      real  _cpus :: selfrefo(10,no11)
      real  _cpus :: forrefo(4,no11)

      real  _gpudeva , dimension(:) :: fracrefaod
      real  _gpudeva , dimension(:) :: fracrefbod

      real  _gpudev :: kaod(5,13,no11)
      real  _gpudev :: kbod(5,13:59,no11)
      real  _gpudeva :: kao_mo2d(:,:)
      real  _gpudeva :: kbo_mo2d(:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 11
! band 11:  1480-1800 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real    
! ka      : real     
! kb      : real     
! ka_mo2  : real     
! kb_mo2  : real     
! selfref : real     
! forref  : real     
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng11 = 8

      real  _cpus, dimension(ng11) :: fracrefa
      real  _cpus, dimension(ng11) :: fracrefb

      real  _cpusnp :: ka(5,13,ng11)   , absa(65,ng11)
      real  _cpusnp :: kb(5,13:59,ng11), absb(235,ng11)
      real  _cpus :: ka_mo2(19,ng11)
      real  _cpus :: kb_mo2(19,ng11)
      real  _cpus :: selfref(10,ng11)
      real  _cpus :: forref(4,ng11)

      real  _gpudeva , dimension(:) :: fracrefad
      real  _gpudeva , dimension(:) :: fracrefbd

      real  _gpudevanp ::   absad(:,:)
      real  _gpudevanp ::   absbd(:,:)
      real  _gpudeva :: ka_mo2d(:,:)
      real  _gpudeva :: kb_mo2d(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU11 1

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )
     
       dbcopnp( absa , absad , 65 ,  ng11 )     
       dbcopnp( absb , absbd , 235 , ng11 )

       dbcop( ka_mo2 , ka_mo2d )
       dbcop( kb_mo2 , kb_mo2d )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg11 1

       dbreg( fracrefa )
       dbreg( fracrefb )

       !dbreg( ka ) 
       dbreg( absa )
       !dbreg( kb )
       dbreg( absb )
       dbreg( ka_mo2 )
       dbreg( kb_mo2 )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg11_f


      module rrlw_kg12_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 12
! band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
! kao     : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no12 = 16

      real  _cpus :: fracrefao(no12,9)
      real  _cpus :: kao(9,5,13,no12)
      real  _cpus :: selfrefo(10,no12)
      real  _cpus :: forrefo(4,no12)

      real  _gpudeva :: fracrefaod(:,:)
      real  _gpudev :: kaod(9,5,13,no12) 
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 12
! band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
! ka      : real     
! selfref : real     
! forref  : real     
!
! absa    : real
!-----------------------------------------------------------------

      integer , parameter :: ng12 = 8

      real  _cpus :: fracrefa(ng12,9)
      real  _cpusnp :: ka(9,5,13,ng12) ,absa(585,ng12)
      real  _cpus :: selfref(10,ng12)
      real  _cpus :: forref(4,ng12)

      real  _gpudeva :: fracrefad(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1))

      contains 


      subroutine copyToGPU12 1

       kao = kaod

       dbcop( fracrefao , fracrefaod )
       !dbcop( kao , kaod ) 
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       !dbcop( ka , kad ) 
       dbcopnp( absa , absad , 585 , ng12 )
     
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine


      subroutine reg12 1

       dbreg( fracrefao )
       !dbreg( kao ) 
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       !dbreg( ka ) 
       dbreg( absa )
     
       dbreg( selfref )
       dbreg( forref )

      end subroutine

      end module rrlw_kg12_f


      module rrlw_kg13_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 13
! band 13:  2080-2250 cm-1 (low - h2o,n2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
! kao     : real     
! kao_mco2: real     
! kao_mco : real     
! kbo_mo3 : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no13 = 16

      real  _cpus, dimension(no13) :: fracrefbo

      real  _cpus :: fracrefao(no13,9)
      real  _cpus :: kao(9,5,13,no13)
      real  _cpus :: kao_mco2(9,19,no13)
      real  _cpus :: kao_mco(9,19,no13)
      real  _cpus :: kbo_mo3(19,no13)
      real  _cpus :: selfrefo(10,no13)
      real  _cpus :: forrefo(4,no13)

      real  _gpudeva , dimension(:) :: fracrefbod

      real  _gpudeva  :: fracrefaod(:,:)
      real  _gpudev  :: kaod(9,5,13,no13)
      real  _gpudeva  :: kao_mco2d(:,:,:)
      real  _gpudeva  :: kao_mcod(:,:,:)
      real  _gpudeva  :: kbo_mo3d(:,:)
      real  _gpudeva  :: selfrefod(:,:)
      real  _gpudeva  :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 13
! band 13:  2080-2250 cm-1 (low - h2o,n2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
! ka      : real     
! ka_mco2 : real     
! ka_mco  : real     
! kb_mo3  : real     
! selfref : real     
! forref  : real     
!
! absa    : real
!-----------------------------------------------------------------

      integer , parameter :: ng13 = 4

      real  _cpus, dimension(ng13) :: fracrefb

      real  _cpus :: fracrefa(ng13,9)
      real  _cpusnp :: ka(9,5,13,ng13) ,absa(585,ng13)
      real  _cpus :: ka_mco2(9,19,ng13)
      real  _cpus :: ka_mco(9,19,ng13)
      real  _cpus :: kb_mo3(19,ng13)
      real  _cpus :: selfref(10,ng13)
      real  _cpus :: forref(4,ng13)

      real  _gpudeva , dimension(:) :: fracrefbd

      real  _gpudeva :: fracrefad(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudeva :: ka_mco2d(:,:,:)
      real  _gpudeva :: ka_mcod(:,:,:)
      real  _gpudeva :: kb_mo3d(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1))

      contains
      

      subroutine copyToGPU13 1

       kaod = kao

       dbcop( fracrefbo , fracrefbod )
       dbcop( fracrefao , fracrefaod )
    
       dbcop( kao_mco2 , kao_mco2d )
       dbcop( kao_mco , kao_mcod )
       dbcop( kbo_mo3 , kbo_mo3d )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefb , fracrefbd )
       dbcop( fracrefa , fracrefad )

       dbcopnp( absa , absad , 585 , ng13)

       dbcop( ka_mco2 , ka_mco2d )
       dbcop( ka_mco , ka_mcod )
       dbcop( kb_mo3 , kb_mo3d )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine
            

      subroutine reg13 1

       dbreg( fracrefbo )
       dbreg( fracrefao )
       !dbreg( kao ) 
       dbreg( kao_mco2 )
       dbreg( kao_mco )
       dbreg( kbo_mo3 )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefb )
       dbreg( fracrefa )
       !dbreg( ka ) 
       dbreg( absa )
       dbreg( ka_mco2 )
       dbreg( ka_mco )
       dbreg( kb_mo3 )
       dbreg( selfref )
       dbreg( forref )

      end subroutine

      end module rrlw_kg13_f


      module rrlw_kg14_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 14
! band 14:  2250-2380 cm-1 (low - co2; high - co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
!fracrefbo: real    
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no14 = 16

      real  _cpus, dimension(no14) :: fracrefao
      real  _cpus, dimension(no14) :: fracrefbo

      real  _cpus :: kao(5,13,no14)
      real  _cpus :: kbo(5,13:59,no14)
      real  _cpus :: selfrefo(10,no14)
      real  _cpus :: forrefo(4,no14)

      real  _gpudeva , dimension(:) :: fracrefaod
      real  _gpudeva , dimension(:) :: fracrefbod

      real  _gpudev :: kaod(5,13,no14)
      real  _gpudev :: kbod(5,13:59,no14)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 14
! band 14:  2250-2380 cm-1 (low - co2; high - co2)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
!fracrefb : real    
! ka      : real     
! kb      : real     
! selfref : real     
! forref  : real     
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng14 = 2

      real  _cpus, dimension(ng14) :: fracrefa
      real  _cpus, dimension(ng14) :: fracrefb

      real  _cpusnp :: ka(5,13,ng14)   ,absa(65,ng14)
      real  _cpusnp :: kb(5,13:59,ng14),absb(235,ng14)
      real  _cpus :: selfref(10,ng14)
      real  _cpus :: forref(4,ng14)

      real  _gpudeva , dimension(:) :: fracrefad
      real  _gpudeva , dimension(:) :: fracrefbd

      real  _gpudevanp ::  absad(:,:)
      real  _gpudevanp ::  absbd(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
      
      contains 


      subroutine copyToGPU14 1

       kaod = kao
       kbod = kbo

       dbcop( fracrefao , fracrefaod )
       dbcop( fracrefbo , fracrefbod )

       !dbcop( kao , kaod ) 
       !dbcop( kbo , kbod )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )

       !dbcop( ka , kad ) 
       !dbcop( kb , kbd )
       dbcopnp( absa , absad , 65 , ng14 )
       dbcopnp( absb , absbd , 235 , ng14 )

       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg14 1

       dbreg( fracrefao )
       dbreg( fracrefbo )

       !dbreg( kao )
       !dbreg( kbo )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       dbreg( fracrefb )

       !dbreg( ka ) 
       !dbreg( kb )
       dbreg( absa )
       dbreg( absb )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg14_f


      module rrlw_kg15_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 15
! band 15:  2380-2600 cm-1 (low - n2o,co2; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
! kao     : real     
! kao_mn2 : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no15 = 16

      real  _cpus :: fracrefao(no15,9)
      real  _cpus :: kao(9,5,13,no15)
      real  _cpus :: kao_mn2(9,19,no15)
      real  _cpus :: selfrefo(10,no15)
      real  _cpus :: forrefo(4,no15)

      real  _gpudeva :: fracrefaod(:,:)
      real  _gpudev :: kaod(9,5,13,no15)
      real  _gpudeva :: kao_mn2d(:,:,:)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 15
! band 15:  2380-2600 cm-1 (low - n2o,co2; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
! ka      : real     
! ka_mn2  : real     
! selfref : real     
! forref  : real     
!
! absa    : real
!-----------------------------------------------------------------

      integer , parameter :: ng15 = 2

      real  _cpus :: fracrefa(ng15,9)
      real  _cpusnp :: ka(9,5,13,ng15) ,absa(585,ng15)
      real  _cpus :: ka_mn2(9,19,ng15)
      real  _cpus :: selfref(10,ng15)
      real  _cpus :: forref(4,ng15)

      real  _gpudeva :: fracrefad(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudeva :: ka_mn2d(:,:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1))

      contains 


      subroutine copyToGPU15 1

       kaod = kao

       dbcop( fracrefao , fracrefaod )
       !dbcop( kao , kaod ) 
       dbcop( kao_mn2 , kao_mn2d )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       !dbcop( ka , kad ) 

       dbcopnp( absa , absad , 585 , ng15 )

       dbcop( ka_mn2 , ka_mn2d )
       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg15 1

       dbreg( fracrefao )
       !dbreg( kao ) 
       dbreg( kao_mn2 )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       !dbreg( ka ) 
       dbreg( absa )
       dbreg( ka_mn2 )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg15_f


      module rrlw_kg16_f 4,1

!     use parkind ,only : im => kind , rb => kind 

      use memory
!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_lw ORIGINAL abs. coefficients for interval 16
! band 16:  2600-3000 cm-1 (low - h2o,ch4; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefao: real    
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real     
!-----------------------------------------------------------------

      integer , parameter :: no16 = 16

      real  _cpus, dimension(no16) :: fracrefbo

      real  _cpus :: fracrefao(no16,9)
      real  _cpus :: kao(9,5,13,no16)
      real  _cpus :: kbo(5,13:59,no16)
      real  _cpus :: selfrefo(10,no16)
      real  _cpus :: forrefo(4,no16)
      
      real  _gpudeva , dimension(:) :: fracrefbod
      real  _gpudeva :: fracrefaod(:,:)
      real  _gpudev :: kaod(9,5,13,no16)
      real  _gpudev :: kbod(5,13:59,no16)
      real  _gpudeva :: selfrefod(:,:)
      real  _gpudeva :: forrefod(:,:)

!-----------------------------------------------------------------
! rrtmg_lw COMBINED abs. coefficients for interval 16
! band 16:  2600-3000 cm-1 (low - h2o,ch4; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!fracrefa : real    
! ka      : real     
! kb      : real     
! selfref : real     
! forref  : real     
!
! absa    : real
! absb    : real
!-----------------------------------------------------------------

      integer , parameter :: ng16 = 2

      real  _cpus, dimension(ng16) :: fracrefb

      real  _cpus :: fracrefa(ng16,9)
      real  _cpusnp :: ka(9,5,13,ng16) ,absa(585,ng16)
      real  _cpusnp :: kb(5,13:59,ng16), absb(235,ng16)
      real  _cpus :: selfref(10,ng16)
      real  _cpus :: forref(4,ng16)

      real  _gpudeva , dimension(:) :: fracrefbd

      real  _gpudeva :: fracrefad(:,:)
      real  _gpudevanp ::  absad(:,:)
      real  _gpudevanp ::   absbd(:,:)
      real  _gpudeva :: selfrefd(:,:)
      real  _gpudeva :: forrefd(:,:)

      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))

      contains 


      subroutine copyToGPU16 1

       kaod = kao
       kbod = kbo

       dbcop( fracrefao , fracrefaod )

       !dbcop( kao , kaod ) 
       !dbcop( kbo , kbod )
       dbcop( selfrefo , selfrefod )
       dbcop( forrefo , forrefod )

       dbcop( fracrefa , fracrefad )
       dbcop( fracrefb , fracrefbd )

       !dbcop( ka , kad ) 
       !dbcop( kb , kbd )
       dbcopnp( absa , absad , 585 , ng16)
       dbcopnp( absb , absbd , 235 , ng16)

       dbcop( selfref , selfrefd )
       dbcop( forref , forrefd )

      end subroutine 


      subroutine reg16 1
 
       dbreg( fracrefao )

       !dbreg( kao ) 
       !dbreg( kbo )
       dbreg( selfrefo )
       dbreg( forrefo )

       dbreg( fracrefa )
       dbreg( fracrefb )

       !dbreg( ka ) 
       !dbreg( kb )
       dbreg( absa )
       dbreg( absb )
       dbreg( selfref )
       dbreg( forref )

      end subroutine 

      end module rrlw_kg16_f


      module rrlw_ncpar

!     use parkind ,only : im => kind , rb => kind 

!     implicit none
      save
        
      real , parameter :: cpdair = 1003.5  ! Specific heat capacity of dry air
                                                         ! at constant pressure at 273 K
                                                         ! (J kg-1 K-1)

        
      integer , parameter :: maxAbsorberNameLength = 5, &
                             Absorber              = 12
      character(len = maxAbsorberNameLength), dimension(Absorber), parameter :: &
      AbsorberNames = (/        &
                                'N2   ',  &
                                'CCL4 ',  &
                                'CFC11',  &
                                'CFC12',  &
                                'CFC22',  &
                                'H2O  ',  &
                                'CO2  ',  &
                                'O3   ',  &
                                'N2O  ',  & 
                                'CO   ',  &
                                'CH4  ',  &
                                'O2   '  /)
        
       integer , dimension(40) :: status
       integer  :: i
       integer , parameter :: keylower  = 9,   &
                               keyupper  = 5,   &
                               Tdiff     = 5,   &
                               ps        = 59,  &
                               plower    = 13,  &
                               pupper    = 47,  &
                               Tself     = 10,  &
                               Tforeign  = 4,   &
                               pforeign  = 4,   &
                               T         = 19,  &
                               Tplanck   = 181, &
                               band      = 16,  &
                               GPoint    = 16,  &
                               GPointSet = 2
                                                  
      contains 
        

      subroutine getAbsorberIndex(AbsorberName,AbsorberIndex)
                character(len = *), intent(in) :: AbsorberName
                integer , intent(out)           :: AbsorberIndex
                
                integer  :: m
        
                AbsorberIndex = -1
                do m = 1, Absorber
                        if (trim(AbsorberNames(m)) == trim(AbsorberName)) then
                                AbsorberIndex = m
                        end if
                end do
                
                if (AbsorberIndex == -1) then
                        print*, "Absorber name index lookup failed."
                end if
      end subroutine getAbsorberIndex

      end module rrlw_ncpar


      module rrlw_ref_f 15

!     use parkind, only : im => kind , rb => kind 

!     implicit none

!------------------------------------------------------------------
! rrtmg_lw reference atmosphere 
! Based on standard mid-latitude summer profile
!
! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! pref   :  real   : Reference pressure levels
! preflog:  real   : Reference pressure levels, ln(pref)
! tref   :  real   : Reference temperature levels for MLS profile
! chi_mls:  real   : 
!------------------------------------------------------------------

      real , dimension(59) :: pref
      real , dimension(59) :: preflog
      real , dimension(59) :: tref
      real :: chi_mls(7,59)

      ! (dmb 2012) These GPU arrays are defined as constant so that they are cached.
      ! This is really needed because they accessed in quite a scattered pattern.
      real _gpucon :: chi_mlsd(7,59)
      real _gpucon :: preflogd(59)
      real _gpucon :: trefd(59)

#ifndef _ACCEL
# define chi_mlsd chi_mls
# define preflogd preflog
# define trefd tref
#endif

      contains

      ! (dmb 2012) Copy the reference arrays over to the GPU

      subroutine copyToGPUref() 1

        chi_mlsd = chi_mls
        preflogd = preflog
        trefd = tref

      end subroutine 

      end module rrlw_ref_f


      module rrlw_tbl_f 4

!     use parkind, only : im => kind , rb => kind 

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_lw exponential lookup table arrays

! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, Jun 2006
! Revised: MJIacono, AER, Aug 2007
! Revised: MJIacono, AER, Aug 2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! ntbl   :  integer: Lookup table dimension
! tblint :  real   : Lookup table conversion factor
! tau_tbl:  real   : Clear-sky optical depth (used in cloudy radiative
!                    transfer)
! exp_tbl:  real   : Transmittance lookup table
! tfn_tbl:  real   : Tau transition function; i.e. the transition of
!                    the Planck function from that for the mean layer
!                    temperature to that for the layer boundary
!                    temperature as a function of optical depth.
!                    The "linear in tau" method is used to make 
!                    the table.
! pade   :  real   : Pade constant   
! bpade  :  real   : Inverse of Pade constant   
!------------------------------------------------------------------

      integer , parameter :: ntbl = 10000

      real , parameter :: tblint = 10000.0 

      real  , dimension(0:ntbl) :: tau_tbl
      real  , dimension(0:ntbl) :: exp_tbl
      real  , dimension(0:ntbl) :: tfn_tbl

      real , parameter :: pade = 0.278 
      real  :: bpade

      end module rrlw_tbl_f


      module rrlw_vsn_f 7

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_lw version information

! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
!hnamrtm :character: 
!hnamini :character: 
!hnamcld :character: 
!hnamclc :character: 
!hnamrtr :character: 
!hnamrtx :character: 
!hnamrtc :character: 
!hnamset :character: 
!hnamtau :character: 
!hnamatm :character: 
!hnamutl :character: 
!hnamext :character: 
!hnamkg  :character: 
!
! hvrrtm :character: 
! hvrini :character: 
! hvrcld :character: 
! hvrclc :character: 
! hvrrtr :character: 
! hvrrtx :character: 
! hvrrtc :character: 
! hvrset :character: 
! hvrtau :character: 
! hvratm :character: 
! hvrutl :character: 
! hvrext :character: 
! hvrkg  :character: 
!------------------------------------------------------------------

      character*18 hvrrtm,hvrini,hvrcld,hvrclc,hvrrtr,hvrrtx, &
                   hvrrtc,hvrset,hvrtau,hvratm,hvrutl,hvrext
      character*20 hnamrtm,hnamini,hnamcld,hnamclc,hnamrtr,hnamrtx, &
                   hnamrtc,hnamset,hnamtau,hnamatm,hnamutl,hnamext

      character*18 hvrkg
      character*20 hnamkg

      end module rrlw_vsn_f


      module rrlw_wvn_f 9,1

!     use parkind, only : im => kind , rb => kind 
      use parrrtm_f, only : nbndlw, mg, ngptlw, maxinpx

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_lw spectral information

! Initial version:  JJMorcrette, ECMWF, jul1998
! Revised: MJIacono, AER, jun2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! ng     :  integer: Number of original g-intervals in each spectral band
! nspa   :  integer: For the lower atmosphere, the number of reference
!                    atmospheres that are stored for each spectral band
!                    per pressure level and temperature.  Each of these
!                    atmospheres has different relative amounts of the 
!                    key species for the band (i.e. different binary
!                    species parameters).
! nspb   :  integer: Same as nspa for the upper atmosphere
!wavenum1:  real   : Spectral band lower boundary in wavenumbers
!wavenum2:  real   : Spectral band upper boundary in wavenumbers
! delwave:  real   : Spectral band width in wavenumbers
! totplnk:  real   : Integrated Planck value for each band; (band 16
!                    includes total from 2600 cm-1 to infinity)
!                    Used for calculation across total spectrum
!totplk16:  real   : Integrated Planck value for band 16 (2600-3250 cm-1)
!                    Used for calculation in band 16 only if 
!                    individual band output requested
!totplnkderiv: real: Integrated Planck function derivative with respect
!                    to temperature for each band; (band 16
!                    includes total from 2600 cm-1 to infinity)
!                    Used for calculation across total spectrum
!totplk16deriv:real: Integrated Planck function derivative with respect
!                    to temperature for band 16 (2600-3250 cm-1)
!                    Used for calculation in band 16 only if 
!                    individual band output requested
!
! ngc    :  integer: The number of new g-intervals in each band
! ngs    :  integer: The cumulative sum of new g-intervals for each band
! ngm    :  integer: The index of each new g-interval relative to the
!                    original 16 g-intervals in each band
! ngn    :  integer: The number of original g-intervals that are 
!                    combined to make each new g-intervals in each band
! ngb    :  integer: The band index for each new g-interval
! wt     :  real   : RRTM weights for the original 16 g-intervals
! rwgt   :  real   : Weights for combining original 16 g-intervals 
!                    (256 total) into reduced set of g-intervals 
!                    (140 total)
! nxmol  :  integer: Number of cross-section molecules
! ixindx :  integer: Flag for active cross-sections in calculation
!------------------------------------------------------------------

      integer  :: ng(nbndlw)
      integer  :: nspa(nbndlw)
      integer  :: nspb(nbndlw)

      real  :: wavenum1(nbndlw)
      real  :: wavenum2(nbndlw)
      real  :: delwave(nbndlw)

      real  :: totplnk(181,nbndlw)
      real  :: totplk16(181)

      real  :: totplnkderiv(181,nbndlw)
      real  :: totplk16deriv(181)

      integer  :: ngc(nbndlw)
      integer  :: ngs(nbndlw)
      integer  :: ngn(ngptlw)
      integer  :: ngb(ngptlw)
      integer  :: ngm(nbndlw*mg)

      real  :: wt(mg)
      real  :: rwgt(nbndlw*mg)

      integer  :: nxmol
      integer  :: ixindx(maxinpx)

      end module rrlw_wvn_f


! Fortran-95 implementation of the Mersenne Twister 19937, following 
!   the C implementation described below (code mt19937ar-cok.c, dated 2002/2/10), 
!   adapted cosmetically by making the names more general.  
! Users must declare one or more variables of type randomNumberSequence in the calling 
!   procedure which are then initialized using a required seed. If the 
!   variable is not initialized the random numbers will all be 0. 
! For example: 
! program testRandoms 
!   use RandomNumbers
!   type(randomNumberSequence) :: randomNumbers
!   integer                    :: i
!   
!   randomNumbers = new_RandomNumberSequence(seed = 100)
!   do i = 1, 10
!     print ('(f12.10, 2x)'), getRandomReal(randomNumbers)
!   end do
! end program testRandoms
! 
! Fortran-95 implementation by 
!   Robert Pincus
!   NOAA-CIRES Climate Diagnostics Center
!   Boulder, CO 80305 
!   email: Robert.Pincus@colorado.edu
!
! This documentation in the original C program reads:
! -------------------------------------------------------------
!    A C-program for MT19937, with initialization improved 2002/2/10.
!    Coded by Takuji Nishimura and Makoto Matsumoto.
!    This is a faster version by taking Shawn Cokus's optimization,
!    Matthe Bellew's simplification, Isaku Wada's real version.
! 
!    Before using, initialize the state by using init_genrand(seed) 
!    or init_by_array(init_key, key_length).
! 
!    Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
!    All rights reserved.                          
! 
!    Redistribution and use in source and binary forms, with or without
!    modification, are permitted provided that the following conditions
!    are met:
! 
!      1. Redistributions of source code must retain the above copyright
!         notice, this list of conditions and the following disclaimer.
! 
!      2. Redistributions in binary form must reproduce the above copyright
!         notice, this list of conditions and the following disclaimer in the
!         documentation and/or other materials provided with the distribution.
! 
!      3. The names of its contributors may not be used to endorse or promote 
!         products derived from this software without specific prior written 
!         permission.
! 
!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
!    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
!    A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR
!    CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
!    EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
!    PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
!    PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
!    LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
!    NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
!    SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! 
! 
!    Any feedback is very welcome.
!    http://www.math.keio.ac.jp/matumoto/emt.html
!    email: matumoto@math.keio.ac.jp
! -------------------------------------------------------------


  module MersenneTwister_f 1,2
! -------------------------------------------------------------

   !use parkind, only : im => kind , rb => kind  

  implicit none
  private
  
  ! Algorithm parameters
  ! -------
  ! Period parameters
  integer , parameter :: blockSize = 624,         &
                        M         = 397,         &
                        MATRIX_A  = -1727483681, & ! constant vector a         (0x9908b0dfUL)
!                        UMASK     = -2147483648, & ! most significant w-r bits (0x80000000UL)
                        UMASK     = -2147483647, & ! most significant w-r bits (0x80000000UL)
                        LMASK     =  2147483647    ! least significant r bits  (0x7fffffffUL)
  ! Tempering parameters
  integer , parameter :: TMASKB= -1658038656, & ! (0x9d2c5680UL)
                        TMASKC= -272236544     ! (0xefc60000UL)
  ! -------

  ! The type containing the state variable  
  type randomNumberSequence
    integer                             :: currentElement ! = blockSize
    integer , dimension(0:blockSize -1) :: state ! = 0
  end type randomNumberSequence


  interface new_RandomNumberSequence
    module procedure initialize_scalar, initialize_vector
  end interface new_RandomNumberSequence 

  public :: randomNumberSequence
  public :: new_RandomNumberSequence, finalize_RandomNumberSequence, &
            getRandomInt, getRandomPositiveInt, getRandomReal
! -------------------------------------------------------------
contains
  ! -------------------------------------------------------------
  ! Private functions
  ! ---------------------------

  function mixbits(u, v)
    integer , intent( in) :: u, v
    integer               :: mixbits
    
    mixbits = ior(iand(u, UMASK), iand(v, LMASK))
  end function mixbits
  ! ---------------------------

  function twist(u, v)
    integer , intent( in) :: u, v
    integer               :: twist

    ! Local variable
    integer , parameter, dimension(0:1) :: t_matrix = (/ 0 , MATRIX_A /)
    
    twist = ieor(ishft(mixbits(u, v), -1 ), t_matrix(iand(v, 1 )))
    twist = ieor(ishft(mixbits(u, v), -1 ), t_matrix(iand(v, 1 )))
  end function twist
  ! ---------------------------

  subroutine nextState(twister) 2
    type(randomNumberSequence), intent(inout) :: twister
    
    ! Local variables
    integer  :: k
    
    do k = 0, blockSize - M - 1
      twister%state(k) = ieor(twister%state(k + M), &
                              twist(twister%state(k), twister%state(k + 1 )))
    end do 
    do k = blockSize - M, blockSize - 2
      twister%state(k) = ieor(twister%state(k + M - blockSize), &
                              twist(twister%state(k), twister%state(k + 1 )))
    end do 
    twister%state(blockSize - 1 ) = ieor(twister%state(M - 1 ), &
                                        twist(twister%state(blockSize - 1 ), twister%state(0 )))
    twister%currentElement = 0 

  end subroutine nextState
  ! ---------------------------

  elemental function temper(y) 2
    integer , intent(in) :: y
    integer              :: temper
    
    integer  :: x
    
    ! Tempering
    x      = ieor(y, ishft(y, -11))
    x      = ieor(x, iand(ishft(x,  7), TMASKB))
    x      = ieor(x, iand(ishft(x, 15), TMASKC))
    temper = ieor(x, ishft(x, -18))
  end function temper
  ! -------------------------------------------------------------
  ! Public (but hidden) functions
  ! --------------------

  function initialize_scalar(seed) result(twister) 4
    integer ,       intent(in   ) :: seed
    type(randomNumberSequence)                :: twister 
    
    integer  :: i
    ! See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. In the previous versions, 
    !   MSBs of the seed affect only MSBs of the array state[].                       
    !   2002/01/09 modified by Makoto Matsumoto            
    
    twister%state(0) = iand(seed, -1 )
    do i = 1,  blockSize - 1 ! ubound(twister%state)
       twister%state(i) = 1812433253  * ieor(twister%state(i-1), &
                                            ishft(twister%state(i-1), -30 )) + i
       twister%state(i) = iand(twister%state(i), -1 ) ! for >32 bit machines
    end do
    twister%currentElement = blockSize
  end function initialize_scalar
  ! -------------------------------------------------------------

  function initialize_vector(seed) result(twister) 2,2
    integer , dimension(0:), intent(in) :: seed
    type(randomNumberSequence)                      :: twister 
    
    integer  :: i, j, k, nFirstLoop, nWraps
    
    nWraps  = 0
    twister = initialize_scalar(19650218 )
    
    nFirstLoop = max(blockSize, size(seed))
    do k = 1, nFirstLoop
       i = mod(k + nWraps, blockSize)
       j = mod(k - 1,      size(seed))
       if(i == 0) then
         twister%state(i) = twister%state(blockSize - 1)
         twister%state(1) = ieor(twister%state(1),                                 &
                                 ieor(twister%state(1-1),                          & 
                                      ishft(twister%state(1-1), -30 )) * 1664525 ) + & 
                            seed(j) + j ! Non-linear
         twister%state(i) = iand(twister%state(i), -1 ) ! for >32 bit machines
         nWraps = nWraps + 1
       else
         twister%state(i) = ieor(twister%state(i),                                 &
                                 ieor(twister%state(i-1),                          & 
                                      ishft(twister%state(i-1), -30 )) * 1664525 ) + & 
                            seed(j) + j ! Non-linear
         twister%state(i) = iand(twister%state(i), -1 ) ! for >32 bit machines
      end if
    end do
    
    !
    ! Walk through the state array, beginning where we left off in the block above
    ! 
    do i = mod(nFirstLoop, blockSize) + nWraps + 1, blockSize - 1
      twister%state(i) = ieor(twister%state(i),                                 &
                              ieor(twister%state(i-1),                          & 
                                   ishft(twister%state(i-1), -30 )) * 1566083941 ) - i ! Non-linear
      twister%state(i) = iand(twister%state(i), -1 ) ! for >32 bit machines
    end do
    
    twister%state(0) = twister%state(blockSize - 1) 
    
    do i = 1, mod(nFirstLoop, blockSize) + nWraps
      twister%state(i) = ieor(twister%state(i),                                 &
                              ieor(twister%state(i-1),                          & 
                                   ishft(twister%state(i-1), -30 )) * 1566083941 ) - i ! Non-linear
      twister%state(i) = iand(twister%state(i), -1 ) ! for >32 bit machines
    end do
    
    twister%state(0) = UMASK 
    twister%currentElement = blockSize
    
  end function initialize_vector
  ! -------------------------------------------------------------
  ! Public functions
  ! --------------------

  function getRandomInt(twister) 4,4
    type(randomNumberSequence), intent(inout) :: twister
    integer                         :: getRandomInt
    ! Generate a random integer on the interval [0,0xffffffff]
    !   Equivalent to genrand_int32 in the C code. 
    !   Fortran doesn't have a type that's unsigned like C does, 
    !   so this is integers in the range -2**31 - 2**31
    ! All functions for getting random numbers call this one, 
    !   then manipulate the result
    
    if(twister%currentElement >= blockSize) call nextState(twister)
      
    getRandomInt = temper(twister%state(twister%currentElement))
    twister%currentElement = twister%currentElement + 1
  
  end function getRandomInt
  ! --------------------

  function getRandomPositiveInt(twister),2
    type(randomNumberSequence), intent(inout) :: twister
    integer                         :: getRandomPositiveInt
    ! Generate a random integer on the interval [0,0x7fffffff]
    !   or [0,2**31]
    !   Equivalent to genrand_int31 in the C code. 
    
    ! Local integers
    integer  :: localInt

    localInt = getRandomInt(twister)
    getRandomPositiveInt = ishft(localInt, -1)
  
  end function getRandomPositiveInt
  ! --------------------
!! mji - modified Jan 2007, double converted to rrtmg real kind type

  function getRandomReal(twister) 10,2
    type(randomNumberSequence), intent(inout) :: twister
!    double precision             :: getRandomReal
    real              :: getRandomReal
    ! Generate a random number on [0,1]
    !   Equivalent to genrand_real1 in the C code
    !   The result is stored as double precision but has 32 bit resolution
    
    integer  :: localInt
    
    localInt = getRandomInt(twister)
    if(localInt < 0) then
!      getRandomReal = dble(localInt + 2.0d0**32)/(2.0d0**32 - 1.0d0)
      getRandomReal = (localInt + 2.0**32 )/(2.0**32  - 1.0 )
    else
!      getRandomReal = dble(localInt            )/(2.0d0**32 - 1.0d0)
      getRandomReal = (localInt            )/(2.0**32  - 1.0 )
    end if

  end function getRandomReal
  ! --------------------

  subroutine finalize_RandomNumberSequence(twister)
    type(randomNumberSequence), intent(inout) :: twister
    
      twister%currentElement = blockSize
      twister%state(:) = 0 
  end subroutine finalize_RandomNumberSequence

  ! --------------------  
  
  end module MersenneTwister_f



  module mcica_random_numbers_f 1,6

  ! Generic module to wrap random number generators. 
  !   The module defines a type that identifies the particular stream of random 
  !   numbers, and has procedures for initializing it and getting real numbers 
  !   in the range 0 to 1. 
  ! This version uses the Mersenne Twister to generate random numbers on [0, 1]. 
  !
  use MersenneTwister_f, only: randomNumberSequence, & ! The random number engine.
                             new_RandomNumberSequence, getRandomReal
!! mji
!!  use time_manager_mod, only: time_type, get_date

   !use parkind, only : im => kind , rb => kind  

  implicit none
  private
  
  type randomNumberStream
    type(randomNumberSequence) :: theNumbers
  end type randomNumberStream
  

  interface getRandomNumbers
    module procedure getRandomNumber_Scalar, getRandomNumber_1D, getRandomNumber_2D
  end interface getRandomNumbers
  

  interface initializeRandomNumberStream
    module procedure initializeRandomNumberStream_S, initializeRandomNumberStream_V
  end interface initializeRandomNumberStream

  public :: randomNumberStream,                             &
            initializeRandomNumberStream, getRandomNumbers
!! mji
!!            initializeRandomNumberStream, getRandomNumbers, &
!!            constructSeed
contains
  ! ---------------------------------------------------------
  ! Initialization
  ! ---------------------------------------------------------

  function initializeRandomNumberStream_S(seed) result(new)  2
    integer , intent( in)     :: seed
    type(randomNumberStream) :: new
    
    new%theNumbers = new_RandomNumberSequence(seed)
    
  end function initializeRandomNumberStream_S
  ! ---------------------------------------------------------

  function initializeRandomNumberStream_V(seed) result(new)  2
    integer , dimension(:), intent( in) :: seed
    type(randomNumberStream)           :: new
    
    new%theNumbers = new_RandomNumberSequence(seed)
    
  end function initializeRandomNumberStream_V
  ! ---------------------------------------------------------
  ! Procedures for drawing random numbers
  ! ---------------------------------------------------------

  subroutine getRandomNumber_Scalar(stream, number) 2,2
    type(randomNumberStream), intent(inout) :: stream
    real ,                     intent(  out) :: number
    
    number = getRandomReal(stream%theNumbers)
  end subroutine getRandomNumber_Scalar
  ! ---------------------------------------------------------

  subroutine getRandomNumber_1D(stream, numbers) 4,2
    type(randomNumberStream), intent(inout) :: stream
    real , dimension(:),       intent(  out) :: numbers
    
    ! Local variables
    integer  :: i
    
    do i = 1, size(numbers)
      numbers(i) = getRandomReal(stream%theNumbers)
    end do
  end subroutine getRandomNumber_1D
  ! ---------------------------------------------------------

  subroutine getRandomNumber_2D(stream, numbers) 2,2
    type(randomNumberStream), intent(inout) :: stream
    real , dimension(:, :),    intent(  out) :: numbers
    
    ! Local variables
    integer  :: i
    
    do i = 1, size(numbers, 2)
      call getRandomNumber_1D(stream, numbers(:, i))
    end do
  end subroutine getRandomNumber_2D
! mji
!  ! ---------------------------------------------------------
!  ! Constructing a unique seed from grid cell index and model date/time
!  !   Once we have the GFDL stuff we'll add the year, month, day, hour, minute
!  ! ---------------------------------------------------------
!  function constructSeed(i, j, time) result(seed)
!    integer ,         intent( in)  :: i, j
!    type(time_type), intent( in) :: time
!    integer , dimension(8) :: seed
!    
!    ! Local variables
!    integer  :: year, month, day, hour, minute, second
!    
!    
!    call get_date(time, year, month, day, hour, minute, second)
!    seed = (/ i, j, year, month, day, hour, minute, second /)
!  end function constructSeed

  end module mcica_random_numbers_f


      module gpu_mcica_subcol_gen_lw 2,4

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2006-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! Purpose: Create McICA stochastic arrays for cloud physical or optical properties.
! Two options are possible:
! 1) Input cloud physical properties: cloud fraction, ice and liquid water
!    paths, ice fraction, and particle sizes.  Output will be stochastic
!    arrays of these variables.  (inflag = 1)
! 2) Input cloud optical properties directly: cloud optical depth, single
!    scattering albedo and asymmetry parameter.  Output will be stochastic
!    arrays of these variables.  (inflag = 0; longwave scattering is not
!    yet available, ssac and asmc are for future expansion)

! --------- Modules ----------

       !use parkind, only : im => kind , rb => kind 
      use parrrtm_f, only : nbndlw, ngptlw, mxlay
      use rrlw_con_f, only: grav
      use rrlw_wvn_f, only: ngb
      use rrlw_vsn_f

#ifdef _ACCEL
      use cudafor
      use cudadevice
#endif

      implicit none

#ifdef _ACCEL
      real  _gpudev, allocatable :: pmidd(:, :)
      real  _gpudev, allocatable :: cldfracd(:,:), clwpd(:,:), ciwpd(:,:), cswpd(:,:), taucd(:,:,:)

!$OMP THREADPRIVATE(pmidd,cldfracd,clwpd,ciwpd,cswpd,taucd)
#endif

! public interfaces/functions/subroutines
      !public :: mcica_subcol_lwg, generate_stochastic_cloudsg 

      contains

!------------------------------------------------------------------
! Public subroutines
!------------------------------------------------------------------


      subroutine mcica_subcol_lwg(colstart, ncol, nlay, icld, permuteseed, irng,       & 1
#ifndef _ACCEL
                       pmidd,clwpd,ciwpd,cswpd,taucd, &
#endif
                       play, cldfrac, ciwp, clwp, cswp, tauc, ngbd, cldfmcl, &
                       ciwpmcl, clwpmcl, cswpmcl, taucmcl)

! ----- Input -----
! Control
      integer , intent(in) :: colstart        ! column/longitude index
      integer , intent(in) :: ncol            ! number of columns
      integer , intent(in) :: nlay            ! number of model layers
      integer , intent(in) :: icld            ! clear/cloud, cloud overlap flag
      integer , intent(in) :: permuteseed     ! if the cloud generator is called multiple times, 
                                                      ! permute the seed between each call.
                                                      ! between calls for LW and SW, recommended
                                                      ! permuteseed differes by 'ngpt'
      integer , intent(in) :: irng         ! flag for random number generator
                                                      !  0 = kissvec
                                                      !  1 = Mersenne Twister
!      integer , intent(in) :: cloudMH, cloudHH

! Atmosphere
      real , intent(in) :: play(:,:)          ! layer pressures (mb) 
                                                      !    Dimensions: (ncol,nlay)

! Atmosphere/clouds - cldprop
      real , intent(in) :: cldfrac(:,:)       ! layer cloud fraction
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: tauc(:,:,:)        ! in-cloud optical depth
                                                      !    Dimensions: (ncol,nbndlw,nlay)
      real , intent(in) :: ciwp(:,:)          ! in-cloud ice water path
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: clwp(:,:)          ! in-cloud liquid water path
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cswp(:,:)          ! in-cloud snow path
                                                      !    Dimensions: (ncol,nlay)
      integer  _gpudev, intent(in) :: ngbd(:)

! ----- Output -----
! Atmosphere/clouds - cldprmc [mcica]
      real  _gpudev, intent(out) :: cldfmcl(:,:,:)    ! cloud fraction [mcica]
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real  _gpudev, intent(out) :: ciwpmcl(:,:,:)    ! in-cloud ice water path [mcica]
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real  _gpudev, intent(out) :: clwpmcl(:,:,:)    ! in-cloud liquid water path [mcica]
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real  _gpudev, intent(out) :: cswpmcl(:,:,:)    ! in-cloud snow water path [mcica]
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real  _gpudev, intent(out) :: taucmcl(:,:,:)    ! in-cloud optical depth [mcica]
                                                      !    Dimensions: (ngptlw,ncol,nlay)

#ifndef _ACCEL
! were module data but changed to arguments because not thread-safe
      real  :: pmidd(:, :)
      real  :: clwpd(:,:), ciwpd(:,:), cswpd(:,:), taucd(:,:,:)
#endif

! ----- Local -----

! Stochastic cloud generator variables [mcica]
      integer , parameter :: nsubclw = ngptlw ! number of sub-columns (g-point intervals)
      integer  :: ilev                        ! loop index

      real  :: pmid(ncol, nlay)               ! layer pressures (Pa) 
#ifdef _ACCEL
      type(dim3) :: dimGrid, dimBlock
#endif
      integer, save :: counter = 0
      integer :: i,j,k,tk
      real :: t1, t2
  
! Return if clear sky; or stop if icld out of range
      if (icld.eq.0) then 
        cldfmcl = 0.0
        ciwpmcl = 0.0
        clwpmcl = 0.0
        cswpmcl = 0.0
        taucmcl = 0.0
!        cloudFlag = 0.0

        return
      end if 
      if (icld.lt.0.or.icld.gt.4) then 
         stop 'MCICA_SUBCOL: INVALID ICLD'
      endif 
   
! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at least the number of subcolumns


! Pass particle sizes to new arrays, no subcolumns for these properties yet
! Convert pressures from mb to Pa

#ifdef  _ACCEL
      pmid(1:ncol,:nlay) = play(colstart:colstart+ncol-1,:nlay)*1.e2
#else
      pmidd(1:ncol,:nlay) = play(colstart:colstart+ncol-1,:nlay)*1.e2
#endif

#ifdef _ACCEL
      allocate( pmidd(ncol, nlay), cldfracd(ncol, mxlay+1))
      allocate( clwpd(ncol, mxlay+1), ciwpd(ncol, mxlay+1), cswpd(ncol, mxlay+1))
      allocate( taucd(ncol, nbndlw, mxlay))
#endif

#ifdef _ACCEL
      pmidd = pmid
    
      cldfracd = cldfrac
      clwpd = clwp
      ciwpd = ciwp
      cswpd = cswp
      taucd = tauc
#endif

      end subroutine mcica_subcol_lwg

!-------------------------------------------------------------------------------------------------

       _gpuker subroutine generate_stochastic_cloudsg(ncol, nlay, icld, ngbd, &,5
#ifndef _ACCEL
                                 pmidd,cldfracd,clwpd,ciwpd,cswpd,taucd,changeSeed, &
#endif
                                 cld_stoch, clwp_stoch, ciwp_stoch, cswp_stoch, &
                                 tauc_stoch) 
!-------------------------------------------------------------------------------------------------

  !----------------------------------------------------------------------------------------------------------------
  ! ---------------------
  ! Contact: Cecile Hannay (hannay@ucar.edu)
  ! 
  ! Original code: Based on Raisanen et al., QJRMS, 2004.
  ! 
  ! Modifications: Generalized for use with RRTMG and added Mersenne Twister as the default
  !   random number generator, which can be changed to the optional kissvec random number generator
  !   with flag 'irng'. Some extra functionality has been commented or removed.  
  !   Michael J. Iacono, AER, Inc., February 2007
  !
  ! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns.
  ! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one 
  ! and uniform cloud liquid and cloud ice concentration.
  ! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer 
  ! and obeys an overlap assumption in the vertical.   
  ! 
  ! Overlap assumption:
  !  The cloud are consistent with 4 overlap assumptions: random, maximum, maximum-random and exponential. 
  !  The default option is maximum-random (option 3)
  !  The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap
  !  This is set with the variable "overlap" 
  !mji - Exponential overlap option (overlap=4) has been deactivated in this version
  !  The exponential overlap uses also a length scale, Zo. (real,    parameter  :: Zo = 2500. ) 
  ! 
  ! Seed:
  !  If the stochastic cloud generator is called several times during the same timestep, 
  !  one should change the seed between the call to insure that the subcolumns are different.
  !  This is done by changing the argument 'changeSeed'
  !  For example, if one wants to create a set of columns for the shortwave and another set for the longwave ,
  !  use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call 
  !
  ! PDF assumption:
  !  We can use arbitrary complicated PDFS. 
  !  In the present version, we produce homogeneuous clouds (the simplest case).  
  !  Future developments include using the PDF scheme of Ben Johnson. 
  !
  ! History file:
  !  Option to add diagnostics variables in the history file. (using FINCL in the namelist)
  !  nsubcol = number of subcolumns
  !  overlap = overlap type (1-3)
  !  Zo = length scale 
  !  CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic)
  !  CLDLIQ_S = mean of the subcolumn cloud water
  !  CLDICE_S = mean of the subcolumn cloud ice 
  !
  ! Note:
  !   Here: we force that the cloud condensate to be consistent with the cloud fraction 
  !   i.e we only have cloud condensate when the cell is cloudy. 
  !   In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations 
  !   and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction 
  !   without cloud condensate or the opposite).
  !---------------------------------------------------------------------------------------------------------------


! -- Arguments

      integer , intent(in) :: ncol            ! number of columns
      integer , intent(in) :: nlay            ! number of layers
      integer , intent(in) :: icld            ! clear/cloud, cloud overlap flag
  
       integer  _gpudev, intent(in) :: ngbd(:)

#ifndef _ACCEL
! were module data but changed to arguments because not thread-safe
      real  :: pmidd(:, :)
      real  :: cldfracd(:,:), clwpd(:,:), ciwpd(:,:), cswpd(:,:), taucd(:,:,:)
      integer, intent(in) :: changeSeed
#endif

!      real , intent(in) :: ssac(:,:,:)       ! in-cloud single scattering albedo
                                                      !    Dimensions: (nbndlw,ncol,nlay)
                                                      !   inactive - for future expansion
!      real , intent(in) :: asmc(:,:,:)       ! in-cloud asymmetry parameter
                                                      !    Dimensions: (nbndlw,ncol,nlay)
                                                      !   inactive - for future expansion

      real  _gpudev, intent(out) :: cld_stoch(:,:,:)  ! subcolumn cloud fraction 
                                                      !    Dimensions: (ncol,ngptlw,nlay)
      real  _gpudev, intent(out) :: clwp_stoch(:,:,:) ! subcolumn in-cloud liquid water path
                                                      !    Dimensions: (ncol,ngptlw,nlay)
      real  _gpudev, intent(out) :: ciwp_stoch(:,:,:) ! subcolumn in-cloud ice water path
                                                      !    Dimensions: (ncol,ngptlw,nlay)
      real  _gpudev, intent(out) :: cswp_stoch(:,:,:) ! subcolumn in-cloud snow water path
                                                      !    Dimensions: (ncol,ngptlw,nlay)
      real  _gpudev, intent(out) :: tauc_stoch(:,:,:) ! subcolumn in-cloud optical depth
                                                      !    Dimensions: (ncol,ngptlw,nlay)
!      real , intent(out) :: ssac_stoch(:,:,:)! subcolumn in-cloud single scattering albedo
                                                      !    Dimensions: (ngptlw,ncol,nlay)
                                                      !   inactive - for future expansion
!      real , intent(out) :: asmc_stoch(:,:,:)! subcolumn in-cloud asymmetry parameter
                                                      !    Dimensions: (ngptlw,ncol,nlay)
                                                      !   inactive - for future expansion
     
      !integer, value, intent(in) :: counter
   
       
! Cloud condensate
      
       real  :: RIND1, RIND2, ZCW, SIGMA_QCW
       integer  :: IND1, IND2
     
       real  :: CDF3(mxlay)      ! random numbers

       real  :: cfs
       integer, parameter :: nsubcol = 140
       
! Constants (min value for cloud fraction and cloud water and ice)
     ! real , parameter :: cldmin = 1.0e-20  ! min cloud fraction
!      real , parameter :: qmin   = 1.0e-10    ! min cloud water and cloud ice (not used)

! Variables related to random number and seed 
#ifdef _ACCEL
      real  :: CDF(mxlay), CDF2(mxlay)      ! random numbers
      integer  :: seed1, seed2, seed3, seed4 ! seed to create random number (kissvec)
      real  :: rand_num      ! random number (kissvec)
#else
      real  :: CDF(ncol,mxlay), CDF2(mxlay)      ! random numbers
      integer,dimension(ncol)  :: seed1, seed2, seed3, seed4 ! seed to create random number (kissvec)
      real ,dimension(ncol) :: rand_num      ! random number (kissvec)
#endif
      integer  :: iseed                       ! seed to create random number (Mersenne Teister)
      real  :: rand_num_mt                    ! random number (Mersenne Twister)

! Flag to identify cloud fraction in subcolumns
   !   logical :: iscloudy(mxlay)   ! flag that says whether a gridbox is cloudy

! Indices
      integer  :: ilev, isubcol, i, n         ! indices
      
      integer :: iplon, gp
      integer  :: m, k, n1, kiss

      m(k, n1) = ieor (k, ishft (k, n1) )
#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      gp = (blockidx%y-1) * blockdim%y + threadidx%y

!------------------------------------------------------------------------------------------ 
     !   print *, "ppp ", iplon, gp
      if (iplon <= ncol .and. gp <= nsubcol) then
# define ILOOP_S_CPU
# define ILOOP_E_CPU
#else
# define ILOOP_S_CPU do iplon = 1, ncol
# define ILOOP_E_CPU enddo
#endif


! ----- Create seed  --------
   
! Advance randum number generator by changeseed values
   
! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works.  
! Must use pmid from bottom four layers. 
#ifdef _ACCEL
           seed1 = (pmidd(iplon,1) - int(pmidd(iplon,1)))  * 1000000000 + (gp) * 11 
           seed3 = (pmidd(iplon,3) - int(pmidd(iplon,3)))  * 1000000000 + (gp) * 13 
           seed2 = seed1 + gp
           seed4 = seed3 - gp 
#else
! Have it agree with the original _lw.F version, jm 20141222
    do iplon = 1, ncol
       seed1(iplon) = (pmidd(iplon,1) - int(pmidd(iplon,1)))  * 1000000000
       seed2(iplon) = (pmidd(iplon,2) - int(pmidd(iplon,2)))  * 1000000000
       seed3(iplon) = (pmidd(iplon,3) - int(pmidd(iplon,3)))  * 1000000000
       seed4(iplon) = (pmidd(iplon,4) - int(pmidd(iplon,4)))  * 1000000000
       do i=1,changeSeed
!          call kissvec(seed1(iplon), seed2(iplon), seed3(iplon), seed4(iplon), rand_num(iplon))

          seed1(iplon) = 69069 * seed1(iplon) + 1327217885
          seed2(iplon) = m (m (m (seed2(iplon), 13), - 17), 5)
          seed3(iplon) = 18000 * iand (seed3(iplon), 65535) + ishft (seed3(iplon), - 16)
          seed4(iplon) = 30903 * iand (seed4(iplon), 65535) + ishft (seed4(iplon), - 16)
          kiss = seed1(iplon) + seed2(iplon) + ishft (seed3(iplon), 16) + seed4(iplon)
          rand_num(iplon) = kiss*2.328306e-10  + 0.5

       enddo
    enddo

     do gp = 1, nsubcol

#endif
  

! ------ Apply overlap assumption --------

! generate the random numbers  

       select case (icld)

#ifdef _ACCEL
! Random overlap
       case(1) 

# if 0
           do ilev = 1,nlay
             call kissvec(seed1, seed2, seed3, seed4, rand_num)
             CDF(iplon,ilev) = rand_num
           end do
# endif
        

! Maximum-Random overlap
       case(2)

           do ilev = 1,nlay
             call kissvec(seed1, seed2, seed3, seed4, rand_num)
             CDF(ilev) = rand_num
           end do
          

           do ilev = 2,nlay
             if (CDF(ilev-1) > 1.  - cldfracd(iplon, ilev-1)) then 
                CDF(ilev) = CDF(ilev-1)
             else
                 CDF(ilev) = CDF(ilev) * (1. - cldfracd(iplon, ilev-1))
             end if
           end do
            
! Maximum overlap
       case(3)

           call kissvec(seed1, seed2, seed3, seed4, rand_num)
           do ilev = 1,nlay
            CDF(ilev) = rand_num
           end do


       end select 
#else
! Random overlap
       case(1)

# if 0
           do ilev = 1,nlay
             call kissvec(seed1, seed2, seed3, seed4, rand_num)
             CDF(iplon,ilev) = rand_num
           end do
# else
   CALL wrf_error_fatal("icld == 1 not supported: module_ra_rrtmg_lwf.F")
#endif

! Maximum-Random overlap
       case(2)
   
           do ilev = 1,nlay
            ILOOP_S_CPU
!             call kissvec(seed1(iplon), seed2(iplon), seed3(iplon), seed4(iplon), rand_num(iplon))
             seed1(iplon) = 69069 * seed1(iplon) + 1327217885
             seed2(iplon) = m (m (m (seed2(iplon), 13), - 17), 5)
             seed3(iplon) = 18000 * iand (seed3(iplon), 65535) + ishft (seed3(iplon), - 16)
             seed4(iplon) = 30903 * iand (seed4(iplon), 65535) + ishft (seed4(iplon), - 16)
             kiss = seed1(iplon) + seed2(iplon) + ishft (seed3(iplon), 16) + seed4(iplon)
             CDF(iplon,ilev) = kiss*2.328306e-10  + 0.5
            ILOOP_E_CPU
           end do
      
         
           do ilev = 2,nlay
            ILOOP_S_CPU
             if (CDF(iplon,ilev-1) > 1.  - cldfracd(iplon, ilev-1)) then 
                CDF(iplon,ilev) = CDF(iplon,ilev-1)
             else
                 CDF(iplon,ilev) = CDF(iplon,ilev) * (1. - cldfracd(iplon, ilev-1))
             end if
            ILOOP_E_CPU
           end do
            
! Maximum overlap
       case(3)

            ILOOP_S_CPU
!           call kissvec(seed1(iplon), seed2(iplon), seed3(iplon), seed4(iplon), rand_num(iplon))
          seed1(iplon) = 69069 * seed1(iplon) + 1327217885
          seed2(iplon) = m (m (m (seed2(iplon), 13), - 17), 5)
          seed3(iplon) = 18000 * iand (seed3(iplon), 65535) + ishft (seed3(iplon), - 16)
          seed4(iplon) = 30903 * iand (seed4(iplon), 65535) + ishft (seed4(iplon), - 16)
          kiss = seed1(iplon) + seed2(iplon) + ishft (seed3(iplon), 16) + seed4(iplon)
          rand_num(iplon) = kiss*2.328306e-10  + 0.5
            ILOOP_E_CPU
           do ilev = 1,nlay
            ILOOP_S_CPU
             CDF(iplon,ilev) = rand_num(iplon)
            ILOOP_E_CPU
           end do

       end select 
#endif

      n = ngbd(gp)

      do ilev = 1,nlay
       ILOOP_S_CPU
        cfs = cldfracd(iplon, ilev)
         !  do gp = 1, nsubcol
#ifdef _ACCEL
               if (CDF(ilev) >=1.  - cfs) then
#else
               if (CDF(iplon,ilev) >=1.  - cfs) then
#endif

                  cld_stoch(iplon,gp,ilev) = 1. 
                  clwp_stoch(iplon,gp,ilev) = clwpd(iplon,ilev)
                  ciwp_stoch(iplon,gp,ilev) = ciwpd(iplon,ilev)
                  cswp_stoch(iplon,gp,ilev) = cswpd(iplon,ilev)
                
                  tauc_stoch(iplon,gp,ilev) = taucd(iplon,n,ilev)
                  
               else
                  cld_stoch(iplon,gp,ilev) = 0. 
                  clwp_stoch(iplon,gp,ilev) = 0. 
                  ciwp_stoch(iplon,gp,ilev) = 0. 
                  cswp_stoch(iplon,gp,ilev) = 0. 
                  tauc_stoch(iplon,gp,ilev) = 0. 
!                  ssac_stoch(isubcol,i,ilev) = 1. 
!                  asmc_stoch(isubcol,i,ilev) = 1. 
               endif
           
       ILOOP_E_CPU
      enddo

#ifdef _ACCEL
      endif
#else
      end do
#endif

      end subroutine generate_stochastic_cloudsg


      _gpuked  subroutine kissvec(seed1,seed2,seed3,seed4,ran_arr) 12
!-------------------------------------------------------------------------------------------------- 

! public domain code
! made available from http://www.fortran.com/
! downloaded by pjr on 03/16/04 for NCAR CAM
! converted to vector form, functions inlined by pjr,mvr on 05/10/2004

! The  KISS (Keep It Simple Stupid) random number generator. Combines:
! (1) The congruential generator x(n)=69069*x(n-1)+1327217885, period 2^32.
! (2) A 3-shift shift-register generator, period 2^32-1,
! (3) Two 16-bit multiply-with-carry generators, period 597273182964842497>2^59
!  Overall period>2^123; 
!
      real , intent(inout)  :: ran_arr
      integer , intent(inout) :: seed1,seed2,seed3,seed4
      integer  :: i,sz,kiss
      integer  :: m, k, n

! inline function 
      m(k, n) = ieor (k, ishft (k, n) )

      seed1 = 69069 * seed1 + 1327217885
      seed2 = m (m (m (seed2, 13), - 17), 5)
      seed3 = 18000 * iand (seed3, 65535) + ishft (seed3, - 16)
      seed4 = 30903 * iand (seed4, 65535) + ishft (seed4, - 16)
      kiss = seed1 + seed2 + ishft (seed3, 16) + seed4
      ran_arr = kiss*2.328306e-10  + 0.5 
    
      end subroutine kissvec

      end module gpu_mcica_subcol_gen_lw

! (dmb 2012) This is the GPU version of the cldprmc routine.  I have parallelized across 
! all 3 dimensions (columns, g-points, and layers) to make this routine run very fast on the GPU.  
! The greatest speedup was obtained by switching the indices for the cloud variables so that 
! the columns were the least significant (leftmost) dimension


      module gpu_rrtmg_lw_cldprmc 1,3

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! --------- Modules ----------

!      use parkind, only : im => kind , rb => kind 
      use parrrtm_f, only : ngptlw, nbndlw
      use rrlw_cld_f, only: abscld1, absliq0, absliq1, &
                          absice0, absice1, absice2, absice3
!      use rrlw_wvn_f, only: ngb
      use rrlw_vsn_f, only: hvrclc, hnamclc

#ifdef _ACCEL
          use cudafor
#endif
      implicit none

#ifdef _ACCEL
! (dmb 2012) I moved most GPU variables so that they are module level variables.
! PGI Fortran seems to sometimes have trouble passing arrays into kernels correctly.
! Using module level variables bypasses this issue and allows for cleaner code.
! (jm 2014) but not thread safe.
      integer  _gpudev, allocatable :: inflagd(:), iceflagd(:), liqflagd(:)

      real  _gpudev, allocatable :: ciwpmcd(:,:,:)    ! in-cloud ice water path [mcica]
      real  _gpudev, allocatable :: clwpmcd(:,:,:)    ! in-cloud liquid water path [mcica]
      real  _gpudev, allocatable :: cswpmcd(:,:,:)    ! in-cloud snow water path [mcica]
                                                      !    Dimensions: (ncol,ngptlw,nlayers)
      real  _gpudev, allocatable :: relqmcd(:,:)      ! liquid particle effective radius (microns)
      real  _gpudev, allocatable :: reicmcd(:,:)      ! ice particle effective size (microns)
      real  _gpudev, allocatable :: resnmcd(:,:)      ! snow particle effective size (microns)
                                                      !    Dimensions: (ncol,nlayers)
                                                      ! specific definition of reicmc depends on setting of iceflag:
                                                      ! iceflag = 0: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !              r_ec must be >= 10.0 microns
                                                      ! iceflag = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !              r_ec range is limited to 13.0 to 130.0 microns
                                                      ! iceflag = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
                                                      !              r_k range is limited to 5.0 to 131.0 microns
                                                      ! iceflag = 3: generalized effective size, dge, (Fu, 1996),
                                                      !              dge range is limited to 5.0 to 140.0 microns
                                                      !              [dge = 1.0315 * r_ec]
 
      real  _gpucon, dimension(2) :: absice0d
      real  _gpucon, dimension(2,5) :: absice1d
      real  _gpucon, dimension(43,16) :: absice2d
      real  _gpucon, dimension(46,16) :: absice3d
      real  _gpucon, dimension(58,16) :: absliq1d


! (jm 2014) My reading of threadprivate documentation says this should work,
!      see http://publib.boulder.ibm.com/infocenter/comphelp/v101v121
! but keep an eye on it. Different vendors have extended this in different ways.
! See also the intel -qopenmp-threadprivate=legacy/compat documentation.
!$OMP THREADPRIVATE(inflagd,iceflagd,liqflagd,ciwpmcd,clwpmcd,cswpmcd,relqmcd,reicmcd,resnmcd, &
!$OMP               absice0d,absice1d,absice2d,absice3d,absliq1d)
#endif

      contains

! ------------------------------------------------------------------------------

      _gpuker subroutine cldprmcg(ncol, nlayers,                                           &,1
#ifndef _ACCEL
                inflagd,iceflagd,liqflagd,ciwpmcd,clwpmcd,cswpmcd,relqmcd,reicmcd,resnmcd, &
                absice0d,absice1d,absice2d,absice3d,absliq1d,                              &
#endif
                                  cldfmc, taucmc, ngb, icb, ncbands, icldlyr)
! ------------------------------------------------------------------------------

! Purpose:  Compute the cloud optical depth(s) for each cloudy layer.

! ------- Input -------

      integer, value, intent(in) :: ncol              ! total number of columns
      integer, value, intent(in) :: nlayers           ! total number of layers

#ifndef _ACCEL
# define ncol CHNK
#endif
      
      real , intent(in) :: cldfmc(ncol, ngptlw, nlayers+1)        ! cloud fraction [mcica]

      integer , intent(out) :: icldlyr( ncol, nlayers+1)
      integer , dimension(140), intent(in)  :: ngb
      integer , intent(in) :: icb(16)
      real , intent(inout) :: taucmc(:,:,:)           ! cloud optical depth [mcica]

      real , parameter :: absliq0 = 0.0903614 

! ------- Output -------

      integer , intent(out) :: ncbands(:)     ! number of cloud spectral bands

#ifndef _ACCEL
!changed to arguments for thread safety on CPU
      integer  :: inflagd(:), iceflagd(:), liqflagd(:)

      real  :: ciwpmcd(:,:,:)    ! in-cloud ice water path [mcica]
      real  :: clwpmcd(:,:,:)    ! in-cloud liquid water path [mcica]
      real  :: cswpmcd(:,:,:)    ! in-cloud snow water path [mcica]
                                                      !    Dimensions: (ncol,ngptlw,nlayers)
      real  :: relqmcd(:,:)      ! liquid particle effective radius (microns)
      real  :: reicmcd(:,:)      ! ice particle effective size (microns)
      real  :: resnmcd(:,:)      ! snow particle effective size (microns)
                                                      !    Dimensions: (ncol,nlayers)
                                                      ! specific definition of reicmc depends on setting of iceflag:
                                                      ! iceflag = 0: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !              r_ec must be >= 10.0 microns
                                                      ! iceflag = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !              r_ec range is limited to 13.0 to 130.0 microns
                                                      ! iceflag = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
                                                      !              r_k range is limited to 5.0 to 131.0 microns
                                                      ! iceflag = 3: generalized effective size, dge, (Fu, 1996),
                                                      !              dge range is limited to 5.0 to 140.0 microns
                                                      !              [dge = 1.0315 * r_ec]
 
      real, dimension(2) :: absice0d
      real, dimension(2,5) :: absice1d
      real, dimension(43,16) :: absice2d
      real, dimension(46,16) :: absice3d
      real, dimension(58,16) :: absliq1d
#endif

! ------- Local -------

      integer  :: iplon
      integer  :: lay                         ! Layer index
      integer  :: ib                          ! spectral band index
      integer  :: ig                          ! g-point interval index
      integer  :: index 
     

      real  :: abscoice                       ! ice absorption coefficients
      real  :: abscoliq                       ! liquid absorption coefficients
      real  :: abscosno                       ! snow absorption coefficients
      real  :: cwp                            ! cloud water path
      real  :: radice                         ! cloud ice effective size (microns)
      real  :: radliq                         ! cloud liquid droplet radius (microns)
      real  :: radsno                         ! cloud snow effective radius (microns)
      real  :: factor                         ! 
      real  :: fint                           ! 
      real , parameter :: eps = 1.e-6         ! epsilon
      real , parameter :: cldmin = 1.e-20     ! minimum value for cloud quantities

      character*256 errmess
! ------- Definitions -------

!     Explanation of the method for each value of INFLAG.  Values of
!     0 or 1 for INFLAG do not distingish being liquid and ice clouds.
!     INFLAG = 2 does distinguish between liquid and ice clouds, and
!     requires further user input to specify the method to be used to 
!     compute the aborption due to each.
!     INFLAG = 0:  For each cloudy layer, the cloud fraction and (gray)
!                  optical depth are input.  
!     INFLAG = 1:  For each cloudy layer, the cloud fraction and cloud
!                  water path (g/m2) are input.  The (gray) cloud optical 
!                  depth is computed as in CCM2.
!     INFLAG = 2:  For each cloudy layer, the cloud fraction, cloud 
!                  water path (g/m2), and cloud ice fraction are input.
!       ICEFLAG = 0:  The ice effective radius (microns) is input and the
!                     optical depths due to ice clouds are computed as in CCM3.
!       ICEFLAG = 1:  The ice effective radius (microns) is input and the
!                     optical depths due to ice clouds are computed as in 
!                     Ebert and Curry, JGR, 97, 3831-3836 (1992).  The 
!                     spectral regions in this work have been matched with
!                     the spectral bands in RRTM to as great an extent 
!                     as possible:  
!                     E&C 1      IB = 5      RRTM bands 9-16
!                     E&C 2      IB = 4      RRTM bands 6-8
!                     E&C 3      IB = 3      RRTM bands 3-5
!                     E&C 4      IB = 2      RRTM band 2
!                     E&C 5      IB = 1      RRTM band 1
!       ICEFLAG = 2:  The ice effective radius (microns) is input and the
!                     optical properties due to ice clouds are computed from
!                     the optical properties stored in the RT code,
!                     STREAMER v3.0 (Reference: Key. J., Streamer 
!                     User's Guide, Cooperative Institute for
!                     Meteorological Satellite Studies, 2001, 96 pp.).
!                     Valid range of values for re are between 5.0 and
!                     131.0 micron.
!       ICEFLAG = 3: The ice generalized effective size (dge) is input
!                    and the optical properties, are calculated as in
!                    Q. Fu, J. Climate, (1998). Q. Fu provided high resolution
!                    tables which were appropriately averaged for the
!                    bands in RRTM_LW.  Linear interpolation is used to
!                    get the coefficients from the stored tables.
!                    Valid range of values for dge are between 5.0 and
!                    140.0 micron.
!       LIQFLAG = 0:  The optical depths due to water clouds are computed as
!                     in CCM3.
!       LIQFLAG = 1:  The water droplet effective radius (microns) is input 
!                     and the optical depths due to water clouds are computed 
!                     as in Hu and Stamnes, J., Clim., 6, 728-742, (1993).
!                     The values for absorption coefficients appropriate for
!                     the spectral bands in RRTM have been obtained for a 
!                     range of effective radii by an averaging procedure 
!                     based on the work of J. Pinto (private communication).
!                     Linear interpolation is used to get the absorption 
!                     coefficients for the input effective radius.

! (dmb 2012) Here insead of looping over the column, layer, and band dimensions,
! I compute the index for each dimension from the grid and block layout.  This 
! function is called once per each thread, and each thread has a unique combination of 
! column, layer, and g-point.  

#ifdef _ACCEL
    iplon = (blockidx%x-1) * blockdim%x + threadidx%x
        lay = (blockidx%y-1) * blockdim%y + threadidx%y
    ig = (blockidx%z-1) * blockdim%z + threadidx%z
! (dmb 2012) Make sure that the column, layer, and g-points are all within the proper
! range.  They can be out of range if we select certain block configurations due to 
! optimizations.
    if (iplon<=ncol .and. lay<=nlayers .and. ig<=ngptlw) then
#else
    do iplon = 1, ncol
      do lay = 1, nlayers
        do ig = 1, ngptlw
#endif

          ncbands(iplon) = 1
! (dmb 2012) all of the cloud variables have been modified so that the column dimensions 
! is least significant.
          if (cldfmc(iplon,ig,lay) .eq. 1. ) then
            icldlyr(iplon, lay)=1
          endif
          cwp = ciwpmcd(iplon,ig,lay) + clwpmcd(iplon,ig,lay) + cswpmcd(iplon,ig,lay)
! (dmb 2012) the stop commands were removed because they aren't supported on the GPU
          if (cldfmc(iplon,ig,lay) .ge. cldmin .and. &
             (cwp .ge. cldmin .or. taucmc(iplon,ig,lay) .ge. cldmin)) then


!jm top cldprmc inflagd           5
!jm top cldprmc iceflagd           5
!jm top cldprmc liqflagd           1


!jm zap            if(inflagd(iplon) .eq. 2) then
            if(inflagd(iplon) .ge. 2) then
               radice = reicmcd(iplon, lay)

! Calculation of absorption coefficients due to ice clouds.
               if (ciwpmcd(iplon,ig,lay)+cswpmcd(iplon,ig,lay) .eq. 0.0) then
                  abscoice = 0.0 
                  abscosno = 0.0 
                                   
               elseif (iceflagd(iplon) .eq. 0) then
                  abscoice= absice0d(1) + absice0d(2)/radice
                  abscosno = 0.0 

               elseif (iceflagd(iplon) .eq. 1) then
                  ncbands(iplon) = 5
                  ib = icb(ngb(ig))
                  abscoice = absice1d(1,ib) + absice1d(2,ib)/radice
                  abscosno = 0.0 

! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns

               elseif (iceflagd(iplon) .eq. 2) then
                  ncbands(iplon) = 16
                  factor = (radice - 2.)/3. 
                  index = int(factor)
! mji - temporary fix to prevent out of range subscripts
                     if (index .le. 0) index = 1
                     if (index .ge. 43) index = 42
!                  if (index .eq. 43) index = 42
                  fint = factor - float(index)
                  ib = ngb(ig)
                  abscoice = &
                      absice2d(index,ib) + fint * &
                      (absice2d(index+1,ib) - (absice2d(index,ib))) 
                  abscosno = 0.0 
               
! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns

!jm               elseif (iceflagd(iplon) .eq. 3) then
               elseif (iceflagd(iplon) .ge. 3) then
                  ncbands(iplon) = 16
                  factor = (radice - 2.)/3. 
                  index = int(factor)
! mji - temporary fix to prevent out of range subscripts
                  if (index .le. 0) index = 1
                  if (index .ge. 46) index = 45
!                  if (index .eq. 46) index = 45
                  fint = factor - float(index)
                  ib = ngb(ig)
                  abscoice= &
                      absice3d(index,ib) + fint * &
                      (absice3d(index+1,ib) - (absice3d(index,ib)))
                  abscosno = 0.0 
               endif
                  
!..Incorporate additional effects due to snow.
               if (cswpmcd(iplon,ig,lay).gt.0.0 .and. iceflagd(iplon) .eq. 5) then
                  radsno = resnmcd(iplon,lay)

#ifndef _ACCEL
                  if (radsno .lt. 5.0 .or. radsno .gt. 140.0) then
                         write(errmess,'(A,i5,i5,i5,f8.2,f8.2)' )         &
               'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS'   &
               ,iplon,ig, lay, cswpmcd(iplon,ig,lay), radsno
                         call wrf_error_fatal(errmess)
                  end if
#endif

                  ncbands(iplon) = 16
                  factor = (radsno - 2.)/3.
                  index = int(factor)
! mji - temporary fix to prevent out of range subscripts
                  if (index .le. 0) index = 1
                  if (index .ge. 46) index = 45
!                  if (index .eq. 46) index = 45
                  fint = factor - float(index)
                  ib = ngb(ig)
                  abscosno = &
                      absice3d(index,ib) + fint * &
                      (absice3d(index+1,ib) - (absice3d(index,ib)))
               endif

! Calculation of absorption coefficients due to water clouds.
!jm              if (liqflagd(iplon) .eq. 1) then
               if (clwpmcd(iplon,ig,lay) .eq. 0.0) then
                 abscoliq = 0.0
               else if (liqflagd(iplon) .eq. 0) then
                 abscoliq = absliq0
               else if (liqflagd(iplon) .eq. 1) then
                 radliq = relqmcd(iplon, lay)
                 index = int(radliq - 1.5 )
! mji - temporary fix to prevent out of range subscripts
                     if (index .le. 0) index = 1
                     if (index .ge. 58) index = 57
!                 if (index .eq. 0) index = 1
!                 if (index .eq. 58) index = 57
                 fint = radliq - 1.5  - float(index)
                 ib = ngb(ig)
                 abscoliq = &
                     absliq1d(index,ib) + fint * &
                     (absliq1d(index+1,ib) - (absliq1d(index,ib)))
               endif

               taucmc(iplon,ig,lay) = ciwpmcd(iplon,ig,lay) * abscoice + &
                                      clwpmcd(iplon,ig,lay) * abscoliq + &
                                      cswpmcd(iplon,ig,lay) * abscosno


            endif
          endif

#ifdef _ACCEL
    endif
#else
        end do
      end do
    end do
#endif  

      end subroutine cldprmcg

#ifndef _ACCEL
# undef ncol
#endif

      
! (dmb 2012) This subroutine allocates the module level arrays on the GPU

      subroutine allocateGPUcldprmcg(ncol, nlay, ngptlw) 1

         integer , intent(in) :: nlay, ngptlw, ncol
#ifdef _ACCEL
         allocate( inflagd(ncol), iceflagd(ncol), liqflagd(ncol))
         allocate( relqmcd(ncol, nlay+1), reicmcd(ncol, nlay+1))
         allocate( resnmcd(ncol, nlay+1))
      
         allocate( ciwpmcd(ncol, ngptlw, nlay+1))
         allocate( clwpmcd(ncol, ngptlw, nlay+1))
         allocate( cswpmcd(ncol, ngptlw, nlay+1))
#endif
        
      end subroutine

      ! (dmb 2012) This subroutine deallocates any GPU arrays.

      subroutine deallocateGPUcldprmcg() 1

#ifdef _ACCEL
         deallocate( inflagd, iceflagd, liqflagd)
         deallocate( relqmcd, reicmcd, resnmcd)

         deallocate( ciwpmcd)
         deallocate( clwpmcd)
         deallocate( cswpmcd)
#endif
      
      end subroutine

      ! (dmb 2012) This subroutine copies input data from the CPU over to the GPU
      ! for use in the cldprmcg subroutine.

      subroutine copyGPUcldprmcg(inflag, iceflag, liqflag,& 1
                                 absice0, absice1, absice2, absice3, absliq1)
                                
         integer :: inflag(:), iceflag(:), liqflag(:)
        
         real , dimension(:) :: absice0
         real , dimension(:,:) :: absice1
         real , dimension(:,:) :: absice2
         real , dimension(:,:) :: absice3
         real , dimension(:,:) :: absliq1
      
#ifdef _ACCEL
         inflagd = inflag
         iceflagd = iceflag
         liqflagd = liqflag

         absice0d = absice0
         absice1d = absice1
         absice2d = absice2
         absice3d = absice3
         absliq1d = absliq1
#endif
      
      end subroutine 

      end module gpu_rrtmg_lw_cldprmc

! (dmb 2012) This is the GPU version of the rtrnmc subroutine.  This has been greatly
! modified to be efficiently run on the GPU.  Originally, there was a g-point loop within
! this subroutine to perform the summation of the fluxes over the g-points.  This has been
! modified so that this subroutine can be run in parallel across the g-points.  This was
! absolutely critical because of two reasons.
! 1. For a relatively low number of profiles, there wouldn't be enough threads to keep
!    the GPU busy enough to run at full potential.  As a result of this, this subroutine
!    would end up being a bottleneck.
! 2. The memory access for the GPU arrays would be innefient because there would be very
!    little coalescing which is critical for obtaining optimal performance.


      module gpu_rrtmg_lw_rtrnmc 2,4

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! --------- Modules ----------

!      use parkind, only : im => kind , rb => kind 
      use parrrtm_f, only : mg, nbndlw, ngptlw, mxlay
      use rrlw_con_f, only: fluxfac, heatfac
! (jm 2014) not sure why the GPU version defines ntbl 2x instead of using it 
! from rrlw_tbl, but will leave it alone for now. However, it is an error when
! compiling for CPU, at least with the Intel compiler.  Says it's defined twice.
#ifdef _ACCEL
      use rrlw_tbl_f, only: bpade, tblint, tau_tbl, exp_tbl, tfn_tbl
#else
      use rrlw_tbl_f, only: bpade, tblint, tau_tbl, exp_tbl, tfn_tbl, ntbl
#endif

#ifdef _ACCEL
      use cudafor
#endif      
    
      implicit none 
      
#ifdef _ACCEL
! (jm 2014) see comment above)
      integer(kind=4), parameter :: ntbl = 10000
#endif
#ifdef _ACCEL
      integer  _gpucon :: ngsd(nbndlw)      

! (dmb 2012) I moved most GPU variables so that they are module level variables.
! PGI Fortran seems to sometimes have trouble passing arrays into kernels correctly.
! Using module level variables bypasses this issue and allows for cleaner code.
! (jm 2014) but not thread safe.

! Atmosphere
      real , allocatable _gpudev :: taucmcd(:,:,:)
   
      real , allocatable _gpudev, dimension(:,:) :: pzd            ! level (interface) pressures (hPa, mb)
                                                                   !    Dimensions: (ncol,0:nlayers)
      real , allocatable _gpudev, dimension(:) :: pwvcmd           ! precipitable water vapor (cm)
                                                                   !    Dimensions: (ncol)
      real , allocatable _gpudev, dimension(:,:) :: semissd        ! lw surface emissivity
                                                                   !    Dimensions: (ncol,nbndlw)
      real , allocatable _gpudev, dimension(:,:,:) :: planklayd    ! 
                                                                   !    Dimensions: (ncol,nlayers,nbndlw)
      real , allocatable _gpudev, dimension(:,:,:) :: planklevd    ! 
                                                                   !    Dimensions: (ncol,0:nlayers,nbndlw)
      real, allocatable _gpudev, dimension(:,:) :: plankbndd       ! 
                                                                   !    Dimensions: (ncol,nbndlw)
   
      real , allocatable _gpudev :: gurad(:,:,:)          ! upward longwave flux (w/m2)
      real , allocatable _gpudev :: gdrad(:,:,:)          ! downward longwave flux (w/m2)
      real , allocatable _gpudev :: gclrurad(:,:,:)       ! clear sky upward longwave flux (w/m2)
      real , allocatable _gpudev :: gclrdrad(:,:,:)       ! clear sky downward longwave flux (w/m2)

      real  _gpudev, allocatable :: gdtotuflux_dtd(:,:,:) ! change in upward longwave flux (w/m2/k)
                                                          ! with respect to surface temperature

      real  _gpudev, allocatable :: gdtotuclfl_dtd(:,:,:) ! change in clear sky upward longwave flux (w/m2/k)
                                                          ! with respect to surface temperature
  

! Clouds
      integer  _gpudev :: idrvd                       ! flag for calculation of dF/dt from 
                                                      ! Planck derivative [0=off, 1=on]
      real  _gpucon :: bpaded
      real  _gpucon :: heatfacd
      real  _gpucon :: fluxfacd
      real  _gpucon :: a0d(nbndlw), a1d(nbndlw), a2d(nbndlw)
      integer  _gpucon :: delwaved(nbndlw)
      real , allocatable _gpudev :: totufluxd(:,:)     ! upward longwave flux (w/m2)
      real , allocatable _gpudev :: totdfluxd(:,:)     ! downward longwave flux (w/m2)
      real , allocatable _gpudev :: fnetd(:,:)         ! net longwave flux (w/m2)
      real , allocatable _gpudev :: htrd(:,:)          ! longwave heating rate (k/day)
      real , allocatable _gpudev :: totuclfld(:,:)     ! clear sky upward longwave flux (w/m2)
      real , allocatable _gpudev :: totdclfld(:,:)     ! clear sky downward longwave flux (w/m2)
      real , allocatable _gpudev :: fnetcd(:,:)        ! clear sky net longwave flux (w/m2)
      real , allocatable _gpudev :: htrcd(:,:)         ! clear sky longwave heating rate (k/day)
      real , allocatable _gpudev :: dtotuflux_dtd(:,:) ! change in upward longwave flux (w/m2/k)
                                                       ! with respect to surface temperature
      real , allocatable _gpudev :: dtotuclfl_dtd(:,:) ! change in clear sky upward longwave flux (w/m2/k)
                                                       ! with respect to surface temperature
      real , allocatable _gpudev :: dplankbnd_dtd(:,:) 

! (jm 2014)
!$OMP THREADPRIVATE( taucmcd,pzd,pwvcmd,semissd,planklayd,planklevd,plankbndd,gurad,gdrad,gclrurad,gclrdrad,&
!$OMP                gdtotuflux_dtd,gdtotuclfl_dtd,idrvd,bpaded,heatfacd,fluxfacd,a0d,a1d,a2d, &
!$OMP                delwaved,totufluxd,totdfluxd,fnetd,htrd,totuclfld,totdclfld,fnetcd,htrcd,dtotuflux_dtd, &
!$OMP                dtotuclfl_dtd,dplankbnd_dtd )
#endif

      contains

!-----------------------------------------------------------------------------

      _gpuker subroutine rtrnmcg(ncol, nlayers, istart, iend, iout                               &
#include "rrtmg_lw_cpu_args.h"
                                 ,ngb,icldlyr, taug, fracsd, cldfmcd)
!-----------------------------------------------------------------------------
!
!  Original version:   E. J. Mlawer, et al. RRTM_V3.0
!  Revision for GCMs:  Michael J. Iacono; October, 2002
!  Revision for F90:  Michael J. Iacono; June, 2006
!  Revision for dFdT option: M. J. Iacono and E. J. Mlawer, November 2009
!
!  This program calculates the upward fluxes, downward fluxes, and
!  heating rates for an arbitrary clear or cloudy atmosphere.  The input
!  to this program is the atmospheric profile, all Planck function
!  information, and the cloud fraction by layer.  A variable diffusivity 
!  angle (SECDIFF) is used for the angle integration.  Bands 2-3 and 5-9 
!  use a value for SECDIFF that varies from 1.50 to 1.80 as a function of 
!  the column water vapor, and other bands use a value of 1.66.  The Gaussian 
!  weight appropriate to this angle (WTDIFF=0.5) is applied here.  Note that 
!  use of the emissivity angle for the flux integration can cause errors of 
!  1 to 4 W/m2 within cloudy layers.  
!  Clouds are treated with the McICA stochastic approach and maximum-random
!  cloud overlap. 
!  This subroutine also provides the optional capability to calculate
!  the derivative of upward flux respect to surface temperature using
!  the pre-tabulated derivative of the Planck function with respect to 
!  temperature integrated over each spectral band.
!***************************************************************************

! ------- Declarations -------

! ----- Input -----
      integer(kind=4), value, intent(in) :: nlayers         ! total number of layers
      integer(kind=4), value, intent(in) :: ncol            ! total number of columns
      integer(kind=4), value, intent(in) :: istart          ! beginning band of calculation
      integer(kind=4), value, intent(in) :: iend            ! ending band of calculation
      integer(kind=4), value, intent(in) :: iout            ! output option flag
      integer , intent(in) :: ngb(:)                        ! band index
     
      integer , intent(in) :: icldlyr(:,:)
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
      real  _gpudev :: cldfmcd(:,:,:)

#include "rrtmg_lw_cpu_defs.h"
     
   ! ----- Local -----
! Declarations for radiative transfer

#ifndef _ACCEL
# define IDIM (ncol)
# define IDIM1 ncol,
#else
# define IDIM
# define IDIM1
#endif
   
      real  :: atot( IDIM1 mxlay)
      real  :: atrans( IDIM1 mxlay)
      real  :: bbugas( IDIM1 mxlay)
      real  :: bbutot( IDIM1 mxlay)
     
      real  :: uflux( IDIM1 0:mxlay)
      real  :: dflux( IDIM1 0:mxlay)
      real  :: uclfl( IDIM1 0:mxlay)
      real  :: dclfl( IDIM1 0:mxlay)

#ifndef _ACCEL
# define atot(X)     ATOT(iplon,X)
# define atrans(X) ATRANS(iplon,X)
# define bbugas(X) BBUGAS(iplon,X)
# define bbutot(X) BBUTOT(iplon,X)
# define uflux(X)   UFLUX(iplon,X)
# define dflux(X)   DFLUX(iplon,X)
# define uclfl(X)   UCLFL(iplon,X)
# define dclfl(X)   DCLFL(iplon,X)
#endif
    
      real  :: odclds
      real  :: efclfracs
      real  :: absclds

      real  :: secdiff IDIM                         ! secant of diffusivity angle
      real  :: transcld, radld IDIM, radclrd IDIM, plfrac, blay, dplankup, dplankdn
      real  :: odepth, odtot, odepth_rec, odtot_rec, gassrc
      real  :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, tausfac
      real  :: rad0, reflect, radlu IDIM , radclru IDIM
      real  :: d_rad0_dt, d_radlu_dt IDIM , d_radclru_dt IDIM
   
      integer  :: ibnd, ib, lay, lev, l, ig         ! loop indices
      integer  :: igc                               ! g-point interval counter
      integer  :: iclddn IDIM                       ! flag for cloud in down path
      integer  :: ittot, itgas, itr                 ! lookup table indices
   
! ------- Definitions -------
! input
!    nlayers                      ! number of model layers
!    ngptlw                       ! total number of g-point subintervals
!    nbndlw                       ! number of longwave spectral bands
!    ncbands                      ! number of spectral bands for clouds
!    secdiff                      ! diffusivity angle
!    wtdiff                       ! weight for radiance to flux conversion
!    pavel                        ! layer pressures (mb)
!    pz                           ! level (interface) pressures (mb)
!    tavel                        ! layer temperatures (k)
!    tz                           ! level (interface) temperatures(mb)
!    tbound                       ! surface temperature (k)
!    cldfrac                      ! layer cloud fraction
!    taucloud                     ! layer cloud optical depth
!    itr                          ! integer look-up table index
!    icldlyr                      ! flag for cloudy layers
!    iclddn                       ! flag for cloud in column at any layer
!    semiss                       ! surface emissivities for each band
!    reflect                      ! surface reflectance
!    bpade                        ! 1/(pade constant)
!    tau_tbl                      ! clear sky optical depth look-up table
!    exp_tbl                      ! exponential look-up table for transmittance
!    tfn_tbl                      ! tau transition function look-up table

! local
!    atrans                       ! gaseous absorptivity
!    abscld                       ! cloud absorptivity
!    atot                         ! combined gaseous and cloud absorptivity
!    odclr                        ! clear sky (gaseous) optical depth
!    odcld                        ! cloud optical depth
!    odtot                        ! optical depth of gas and cloud
!    tfacgas                      ! gas-only pade factor, used for planck fn
!    tfactot                      ! gas and cloud pade factor, used for planck fn
!    bbdgas                       ! gas-only planck function for downward rt
!    bbugas                       ! gas-only planck function for upward rt
!    bbdtot                       ! gas and cloud planck function for downward rt
!    bbutot                       ! gas and cloud planck function for upward calc.
!    gassrc                       ! source radiance due to gas only
!    efclfrac                     ! effective cloud fraction
!    radlu                        ! spectrally summed upward radiance 
!    radclru                      ! spectrally summed clear sky upward radiance 
!    urad                         ! upward radiance by layer
!    clrurad                      ! clear sky upward radiance by layer
!    radld                        ! spectrally summed downward radiance 
!    radclrd                      ! spectrally summed clear sky downward radiance 
!    drad                         ! downward radiance by layer
!    clrdrad                      ! clear sky downward radiance by layer
!    d_radlu_dt                   ! spectrally summed upward radiance 
!    d_radclru_dt                 ! spectrally summed clear sky upward radiance 
!    d_urad_dt                    ! upward radiance by layer
!    d_clrurad_dt                 ! clear sky upward radiance by layer

! output
!    totuflux                     ! upward longwave flux (w/m2)
!    totdflux                     ! downward longwave flux (w/m2)
!    fnet                         ! net longwave flux (w/m2)
!    htr                          ! longwave heating rate (k/day)
!    totuclfl                     ! clear sky upward longwave flux (w/m2)
!    totdclfl                     ! clear sky downward longwave flux (w/m2)
!    fnetc                        ! clear sky net longwave flux (w/m2)
!    htrc                         ! clear sky longwave heating rate (k/day)
!    dtotuflux_dt                 ! change in upward longwave flux (w/m2/k)
!                                 ! with respect to surface temperature
!    dtotuclfl_dt                 ! change in clear sky upward longwave flux (w/m2/k)
!    
   
  
! This secant and weight corresponds to the standard diffusivity 
! angle.  This initial value is redefined below for some bands.
      real , parameter :: wtdiff = 0.5      
      real , parameter :: rec_6 = 0.166667  

! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
! and 1.80) as a function of total column water vapor.  The function
! has been defined to minimize flux and cooling rate errors in these bands
! over a wide range of precipitable water values.

      integer :: iplon
      real :: bbb

! (dmb 2012) Here we compute the index for the column and band dimensions
#ifdef _ACCEL
   iplon = (blockidx%x-1) * blockdim%x + threadidx%x
   igc = (blockidx%y-1) * blockdim%y + threadidx%y
! (dmb 2012) Make sure that the column and bands are within the proper ranges
   if (iplon <= ncol .and. igc<=140) then

    
#else
      do igc = 1, 140 
# define secdiff   SECDIFF(iplon)
#endif
         ibnd = ngb(igc)

       ILOOP_S_CPU
         if (ibnd.eq.1 .or. ibnd.eq.4 .or. ibnd.ge.10) then
           secdiff = 1.66 
         else
           secdiff = a0d(ibnd) + a1d(ibnd)*exp(a2d(ibnd)*pwvcmd(iplon))
           if (secdiff .gt. 1.80 ) secdiff = 1.80 
           if (secdiff .lt. 1.50 ) secdiff = 1.50 
         endif
         gurad(iplon, igc, 0) = 0.0 
         gdrad(iplon, igc, 0) = 0.0 
!totuflux(iplon,igc,0) = 0.0 
!totdflux(iplon,igc,0) = 0.0 
         gclrurad(iplon, igc, 0) = 0.0 
         gclrdrad(iplon, igc, 0) = 0.0 
!totuclfl(iplon,igc,0) = 0.0 
!totdclfl(iplon,igc,0) = 0.0 
         if (idrvd .eq. 1) then
            gdtotuflux_dtd(iplon,igc,0) = 0.0 
            gdtotuclfl_dtd(iplon,igc,0) = 0.0 
         endif
       ILOOP_E_CPU

         do lay = 1, nlayers
       ILOOP_S_CPU
            gurad(iplon, igc, lay) = 0.0 
            gdrad(iplon, igc, lay) = 0.0 
            gclrurad(iplon, igc, lay) = 0.0 
            gclrdrad(iplon, igc, lay) = 0.0 
          
! (dmb 2012) I removed the band loop here because it was terribly inefficient
! I now set the required variables outside of the kernel

            if (idrvd .eq. 1) then
               gdtotuflux_dtd(iplon,igc,lay) = 0.0 
               gdtotuclfl_dtd(iplon,igc,lay) = 0.0 
            endif
       ILOOP_E_CPU
         enddo

! Radiative transfer starts here.
         radld = 0. 
         radclrd = 0. 
         iclddn = 0

! Downward radiative transfer loop.  

# ifndef _ACCEL
#  define radld   RADLD(iplon)
#  define radclrd RADCLRD(iplon)
#  define iclddn  ICLDDN(iplon)
# endif

         do lev = nlayers, 1, -1
       ILOOP_S_CPU
               plfrac = fracsd(iplon,lev,igc)
               blay = planklayd(iplon,lev,ibnd)
               dplankup = planklevd(iplon,lev,ibnd) - blay
               dplankdn = planklevd(iplon,lev-1,ibnd) - blay
               odepth = secdiff * taug(iplon,lev,igc)
               if (odepth .lt. 0.0 ) odepth = 0.0 
!  Cloudy layer
               if (icldlyr(iplon, lev).eq.1) then
                  iclddn = 1
! (dmb 2012) Here instead of using the lookup tables to compute 
! the optical depth and related quantities, I compute them on the 
! fly because this is actually much more efficient on the GPU.
                  odclds = secdiff * taucmcd(iplon,igc,lev)
                  absclds = 1.  - exp(-odclds)
                  efclfracs = absclds * cldfmcd(iplon, igc,lev)
                  odtot = odepth + odclds
                
#ifdef _ACCEL
                  tblind = odepth/(bpaded+odepth)
                  itgas = tblint*tblind+0.5 
                  bbb = itgas / float(tblint)
                  odepth = bpaded * bbb / (1.  - bbb)

                  atrans(lev) = exp( -odepth)
                  atrans(lev) = 1  -atrans(lev)
! (dmb 2012) Compute tfacgas on the fly.  Even though this is an expensive operation,
! it is more efficient to do the calculation within the kernel on the GPU. 
                  if (odepth < 0.06) then
                     tfacgas = odepth/6. 
                  else
                     tfacgas = 1. -2. *((1. /odepth)-((1.  - atrans(lev))/(atrans(lev))))
                  endif
                  gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn)

                  odtot = odepth + odclds
                  tblind = odtot/(bpaded+odtot)
                  ittot = tblint*tblind + 0.5 
                  bbb = ittot / float(tblint)
                  bbb = bpaded * bbb / (1.  - bbb)
                  atot(lev) = 1.  - exp(-bbb)
                  if (bbb < 0.06) then
                     tfactot = bbb/6. 
                  else
                     tfactot = 1. -2. *((1. /bbb)-((1-atot(lev))/(atot(lev))))
                  endif
                  bbdtot = plfrac * (blay + tfactot*dplankdn)
                  bbd = plfrac*(blay+tfacgas*dplankdn)
#else
                  tblind = odepth/(bpade+odepth)
                  itgas = tblint*tblind+0.5 
                  odepth = tau_tbl(itgas)
                  atrans(lev) = 1.  - exp_tbl(itgas)
                  tfacgas = tfn_tbl(itgas)
                  gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn)

                  odtot = odepth + odclds
                  tblind = odtot/(bpade+odtot)
                  ittot = tblint*tblind + 0.5 
                  tfactot = tfn_tbl(ittot)
                  bbdtot = plfrac * (blay + tfactot*dplankdn)
                  bbd = plfrac*(blay+tfacgas*dplankdn)
                  atot(lev) = 1.  - exp_tbl(ittot)
#endif

                  radld = radld - radld * (atrans(lev) + &
                  efclfracs * (1.  - atrans(lev))) + &
                  gassrc + cldfmcd(iplon, igc,lev) * &
                  (bbdtot * atot(lev) - gassrc)
                  gdrad(iplon, igc, lev-1) = gdrad(iplon, igc, lev-1) + radld 
                  bbugas(lev) = plfrac * (blay + tfacgas * dplankup)
                  bbutot(lev) = plfrac * (blay + tfactot * dplankup)
              
!  Clear layer
               else

#ifdef _ACCEL
                  tblind = odepth/(bpaded+odepth)
                  itr = tblint*tblind+0.5 
! (dmb 2012) Compute the atrans and related values on the fly instead
! of using the lookup tables.
                  bbb = itr/float(tblint)
                  bbb = bpaded * bbb / (1.  - bbb)
                  transc = exp( -bbb )
                  if (transc < 1.e-20 ) transc = 1.e-20 
                  atrans(lev) = 1. -transc

                  if (bbb < 0.06 ) then
                     tausfac = bbb/6. 
                  else
                     tausfac = 1. -2. *((1. /bbb)-(transc/(1.-transc)))
                  endif 

                  bbd = plfrac*(blay+tausfac*dplankdn)
                  bbugas(lev) = plfrac * (blay + tausfac * dplankup)
#else
#  if 0
                  tblind = odepth/(bpade+odepth)
                  itr = tblint*tblind+0.5 
                  transc = exp_tbl(itr)
                  atrans(lev) = 1. -transc
                  tausfac = tfn_tbl(itr)
                  bbd = plfrac*(blay+tausfac*dplankdn)
                  bbugas(lev) = plfrac * (blay + tausfac * dplankup)
#  else
  ! jm agree with the calculation in module_ra_rrtmg_lw.F ~line 3340
                  if (odepth .le. 0.06) then
                     atrans(lev) = odepth-0.5*odepth*odepth
                     odepth = rec_6*odepth
                     bbd = plfrac*(blay+dplankdn*odepth)
                     bbugas(lev) = plfrac*(blay+dplankup*odepth)
                  else
                     tblind = odepth/(bpade+odepth)
                     itr = tblint*tblind+0.5
                     transc = exp_tbl(itr)
                     atrans(lev) = 1.-transc
                     tausfac = tfn_tbl(itr)
                     bbd = plfrac*(blay+tausfac*dplankdn)
                     bbugas(lev) = plfrac * (blay + tausfac * dplankup)
                  endif
#  endif
#endif
                  radld = radld + (bbd-radld )*atrans(lev)
                  gdrad(iplon, igc, lev-1) = gdrad(iplon, igc, lev-1) + radld 

               endif

!  Set clear sky stream to total sky stream as long as layers
!  remain clear.  Streams diverge when a cloud is reached (iclddn=1),
!  and clear sky stream must be computed separately from that point.
               if (iclddn .eq.1) then
                  radclrd = radclrd + (bbd-radclrd) * atrans(lev) 
! (dmb 2012) Rather than summing up the results and then computing the 
! total fluxes, I store the g-point specific values in GPU arrays to be 
! summed up later in a new kernel.  This ensures that we can parallelize 
! across enough dimensions so that the GPU remains busy.
                  gclrdrad(iplon, igc, lev-1) = gclrdrad(iplon, igc, lev-1) + radclrd
               else
                  radclrd = radld 
                  gclrdrad(iplon, igc, lev-1) = gdrad(iplon, igc, lev-1)
               endif
       ILOOP_E_CPU
         enddo   ! end of downward radiation loop

! Spectral emissivity & reflectance
!  Include the contribution of spectrally varying longwave emissivity
!  and reflection from the surface to the upward radiative transfer.
!  Note: Spectral and Lambertian reflection are identical for the
!  diffusivity angle flux integration used here.
!  Note: The emissivity is applied to plankbnd and dplankbnd_dt when 
!  they are defined in subroutine setcoef. 

# ifndef _ACCEL
#  define radlu         RADLU(iplon)
#  define radclru       RADCLRU(iplon)
#  define d_radlu_dt    D_RADLU_DT(iplon)
#  define d_radclru_dt  D_RADCLRU_DT(iplon)
# endif
    
       ILOOP_S_CPU
         rad0 = fracsd(iplon,1,igc) * plankbndd(iplon,ibnd)
!  Add in specular reflection of surface downward radiance.
         reflect = 1.  - semissd(iplon,ibnd)
         radlu = rad0 + reflect * radld
         radclru = rad0 + reflect * radclrd

! Upward radiative transfer loop.
         gurad(iplon, igc, 0) = gurad(iplon, igc, 0) + radlu 
         gclrurad(iplon, igc, 0) = gclrurad(iplon, igc, 0) + radclru
       ILOOP_E_CPU

         do lev = 1, nlayers
       ILOOP_S_CPU
!  Cloudy layer
            if (icldlyr(iplon, lev) .eq. 1) then
               gassrc = bbugas(lev) * atrans(lev)
               odclds = secdiff * taucmcd(iplon,igc,lev)
               absclds = 1.  - exp(-odclds)
               efclfracs = absclds * cldfmcd(iplon, igc,lev)
               radlu = radlu - radlu * (atrans(lev) + &
                   efclfracs * (1.  - atrans(lev))) + &
                   gassrc + cldfmcd(iplon, igc,lev) * &
                   (bbutot(lev) * atot(lev) - gassrc)
               gurad(iplon, igc, lev) = gurad(iplon, igc, lev) + radlu
!  Clear layer
            else
               radlu = radlu + (bbugas(lev)-radlu)*atrans(lev)
               gurad(iplon, igc, lev) = gurad(iplon, igc, lev) + radlu
            endif



!  Set clear sky stream to total sky stream as long as all layers
!  are clear (iclddn=0).  Streams must be calculated separately at 
!  all layers when a cloud is present (ICLDDN=1), because surface 
!  reflectance is different for each stream.
               if (iclddn.eq.1) then
                  radclru = radclru + (bbugas(lev)-radclru)*atrans(lev) 
                  gclrurad(iplon, igc, lev) = gclrurad(iplon, igc, lev) + radclru
               else
                  radclru = radlu
                  gclrurad(iplon, igc, lev) = gurad(iplon, igc, lev)
               endif
       ILOOP_E_CPU
          enddo
          
          
          tblind = wtdiff * delwaved(ibnd) * fluxfacd
 ! (dmb 2012) Now that the g-points values were created, we modify them 
 ! so that later summation (integration) will be simpler.  
          do lev = 0, nlayers  
       ILOOP_S_CPU
           gurad(iplon, igc, lev) = gurad(iplon, igc, lev) * tblind
           gdrad(iplon, igc, lev) = gdrad(iplon, igc, lev) * tblind
           gclrurad(iplon, igc, lev) = gclrurad(iplon, igc, lev) * tblind
           gclrdrad(iplon, igc, lev) = gclrdrad(iplon, igc, lev) * tblind
       ILOOP_E_CPU
          end do

#ifdef _ACCEL
      endif
#else
      end do   ! igc loop
#endif

      end subroutine rtrnmcg

! (dmb 2012) This subroutine adds up the indivial g-point fluxes to arrive at a 
! final upward and downward flux value for each column and layer.  This subroutine 
! is parallelized across the column and layer dimensions.  As long as we parallelize 
! across two of the three dimesnions, we should usually have enough GPU saturation.

      _gpuker subroutine rtrnadd(ncol, nlay, ngpt, drvf                &
#include "rrtmg_lw_cpu_args.h"
                                )

      integer, intent(in), value :: ncol
      integer, intent(in), value :: nlay
      integer, intent(in), value :: ngpt
      integer, intent(in), value :: drvf
#include "rrtmg_lw_cpu_defs.h"
        
      integer :: iplon, ilay, igp
!      real :: d(140)

! (dmb 2012) compute the column and layer indices from the grid and block 
! configurations. 

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      ilay = (blockidx%y-1) * blockdim%y + threadidx%y - 1
       
! (dmb 2012) make sure that the column and layer are within range
      if (ilay <= nlay .and. iplon <= ncol) then
#else
! zap should move this inside the igp loop
      do iplon = 1, ncol
        do ilay = 0, nlay
#endif

          do igp = 1, ngpt
              
            totufluxd(iplon, ilay)=totufluxd(iplon, ilay)+gurad(iplon, igp, ilay)
            totdfluxd(iplon, ilay)=totdfluxd(iplon, ilay)+gdrad(iplon, igp, ilay)
            totuclfld(iplon, ilay)=totuclfld(iplon, ilay)+gclrurad(iplon, igp, ilay)
            totdclfld(iplon, ilay)=totdclfld(iplon, ilay)+gclrdrad(iplon, igp, ilay)

          end do

          if (drvf .eq. 1) then

            do igp = 1, ngpt
                
              dtotuflux_dtd(iplon, ilay) = dtotuflux_dtd(iplon, ilay) + gdtotuflux_dtd( iplon, igp, ilay)
              dtotuclfl_dtd(iplon, ilay) = dtotuclfl_dtd(iplon, ilay) + gdtotuclfl_dtd( iplon, igp, ilay)

            end do

          end if

#ifdef _ACCEL
      end if
#else
        end do
      end do
#endif

      end subroutine

! (dmb 2012) This kernel computes the heating rates separately.  It is parallelized across the 
! columnn and layer dimensions.

      _gpuker subroutine rtrnheatrates(ncol, nlay &
#ifndef _ACCEL
         ,ncol_,nlayers_,nbndlw_,ngptlw_                                                          &
         ,taucmcd,pzd,pwvcmd,semissd,planklayd,planklevd,plankbndd,gurad,gdrad,gclrurad,gclrdrad  &
         ,gdtotuflux_dtd,gdtotuclfl_dtd,idrvd,bpaded,heatfacd,fluxfacd,a0d,a1d,a2d                &
         ,delwaved,totufluxd,totdfluxd,fnetd,htrd,totuclfld,totdclfld,fnetcd,htrcd,dtotuflux_dtd  &
         ,dtotuclfl_dtd,dplankbnd_dtd                                                             &
#endif
                                      )

      integer, intent(in), value :: ncol
      integer, intent(in), value :: nlay
#ifndef _ACCEL
      integer :: ncol_,nlayers_,nbndlw_,ngptlw_
! changed to arguments for thread safety
# ifndef ncol_
#   define ncol_ CHNK
# endif
      integer  :: ngsd(nbndlw)      

! Atmosphere
      real :: taucmcd(ncol_, ngptlw_, nlayers_+1)
   
      real , dimension(ncol_, 0:nlayers_+1) :: pzd      ! level (interface) pressures (hPa, mb)
                                                        !    Dimensions: (ncol,0:nlayers)
      real , dimension(ncol_) :: pwvcmd                 ! precipitable water vapor (cm)
                                                        !    Dimensions: (ncol)
      real , dimension(ncol_,nbndlw_) :: semissd        ! lw surface emissivity
                                                        !    Dimensions: (ncol,nbndlw)
      real , dimension(ncol_,nlayers_+1,nbndlw_) :: planklayd    ! 
                                                        !    Dimensions: (ncol,nlayers+1,nbndlw)
      real , dimension(ncol_,0:nlayers_+1,nbndlw_) :: planklevd    ! 
                                                        !    Dimensions: (ncol,0:nlayers+1,nbndlw)
      real, dimension(ncol_,nbndlw_) :: plankbndd       ! 
                                                        !    Dimensions: (ncol,nbndlw)
   
      real :: gurad(ncol_,ngptlw_,0:nlayers_+1)         ! upward longwave flux (w/m2)
      real :: gdrad(ncol_,ngptlw_,0:nlayers_+1)         ! downward longwave flux (w/m2)
      real :: gclrurad(ncol_,ngptlw_,0:nlayers_+1)      ! clear sky upward longwave flux (w/m2)
      real :: gclrdrad(ncol_,ngptlw_,0:nlayers_+1)      ! clear sky downward longwave flux (w/m2)

      real  :: gdtotuflux_dtd(ncol_, ngptlw_, 0:nlayers_+1) ! change in upward longwave flux (w/m1/k)
                                     ! with respect to surface temperature

      real  :: gdtotuclfl_dtd(ncol_, ngptlw_, 0:nlayers_+1) ! change in clear sky upward longwave flux (w/m2/k)
                                     ! with respect to surface temperature

! Clouds
      integer  :: idrvd                       ! flag for calculation of dF/dt from 
                                                      ! Planck derivative [0=off, 1=on]
      real  :: bpaded
      real  :: heatfacd
      real  :: fluxfacd
      real  :: a0d(nbndlw_), a1d(nbndlw_), a2d(nbndlw_)
      real  :: delwaved(nbndlw_)
      real :: totufluxd(ncol_, 0:nlayers_+1)     ! upward longwave flux (w/m2)
      real :: totdfluxd(ncol_, 0:nlayers_+1)     ! downward longwave flux (w/m2)
      real :: fnetd(ncol_, 0:nlayers_+1)         ! net longwave flux (w/m2)
      real :: htrd(ncol_, 0:nlayers_+1)          ! longwave heating rate (k/day)
      real :: totuclfld(ncol_, 0:nlayers_+1)     ! clear sky upward longwave flux (w/m2)
      real :: totdclfld(ncol_, 0:nlayers_+1)     ! clear sky downward longwave flux (w/m2)
      real :: fnetcd(ncol_, 0:nlayers_+1)        ! clear sky net longwave flux (w/m2)
      real :: htrcd(ncol_, 0:nlayers_+1)         ! clear sky longwave heating rate (k/day)
      real :: dtotuflux_dtd(ncol_, 0:nlayers_+1) ! change in upward longwave flux (w/m2/k)
                                                       ! with respect to surface temperature
      real :: dtotuclfl_dtd(ncol_, 0:nlayers_+1) ! change in clear sky upward longwave flux (w/m2/k)
                                                       ! with respect to surface temperature
      real :: dplankbnd_dtd(ncol_,nbndlw_) 
# undef ncol_
#endif
      
      real :: t2
      integer :: iplon, ilay

#ifdef _ACCEL        
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      ilay = (blockidx%y-1) * blockdim%y + threadidx%y - 1

    
      if (ilay<nlay .and. iplon<=ncol) then
#else
      do iplon = 1, ncol
        do ilay = 0, nlay - 1
#endif
          t2 = pzd(iplon, ilay ) - pzd(iplon, ilay + 1)
          htrd(iplon, ilay) = heatfacd * ((totufluxd(iplon, ilay) - totdfluxd(iplon, ilay)) &
                 - (totufluxd(iplon, ilay+1) - totdfluxd(iplon, ilay+1)))/t2
          htrcd(iplon, ilay) = heatfacd * ((totuclfld(iplon, ilay) - totdclfld(iplon, ilay)) &
                 - (totuclfld(iplon, ilay+1) - totdclfld(iplon, ilay+1)))/t2

#ifdef _ACCEL
      end if
#else
        end do
      end do
#endif
       
      end subroutine

! (dmb 2012) Copy needed variables over to the GPU.  These arrays are pretty small so simple 
! stream 0 assignment operators suffice.

      subroutine copyGPUrtrnmcg(pz, pwvcm, idrv, taut) 1
            
      real , intent(in) :: pz(:,:)             ! level (interface) pressures (hPa, mb)
      integer , intent(in) :: idrv             ! flag for calculation of dF/dt from 
      real , intent(in) :: taut(:,:,:)  
      real , intent(in) :: pwvcm(:)

#ifdef _ACCEL
      pzd = pz
      pwvcmd = pwvcm
      idrvd = idrv
      bpaded = bpade
      heatfacd = heatfac
      fluxfacd = fluxfac
#endif
         
      end subroutine

! (dmb 2012) Allocate the arrays for the rtrnmc routine on the GPU.  Some of these arrays are 
! quite large as they contain all 3 dimensions.  Luckily, for the gurad arrays, no copying of data
! from the CPU is needed because they are only stored on the GPU.

      subroutine allocateGPUrtrnmcg(ncol, nlay, ngptlw, drvf) 1

      integer , intent(in) :: ncol, nlay, ngptlw, drvf
integer,external :: omp_get_thread_num

#ifdef _ACCEL
      allocate( taucmcd(ncol, ngptlw, nlay+1))
      allocate( pzd(ncol, 0:nlay+1))
      allocate( pwvcmd(ncol))
      allocate( semissd(ncol, nbndlw))
      allocate( planklayd(ncol,nlay+1,nbndlw))
      allocate( planklevd(ncol, 0:nlay+1, nbndlw))
      allocate( plankbndd(ncol,nbndlw))
      allocate ( gurad(ncol,ngptlw,0:nlay+1))        ! upward longwave flux (w/m2)
      allocate ( gdrad(ncol,ngptlw,0:nlay+1))        ! downward longwave flux (w/m2)
      allocate ( gclrurad(ncol,ngptlw,0:nlay+1))     ! clear sky upward longwave flux (w/m2)
      allocate ( gclrdrad(ncol,ngptlw,0:nlay+1))     ! clear sky downward longwave flux (w/m2)

! (dmb 2012) Only allocate the optional derivative arrays if the flag is set
      if (drvf .eq. 1) then
            
        allocate( gdtotuflux_dtd( ncol, ngptlw, 0:nlay+1))
        allocate( gdtotuclfl_dtd( ncol, ngptlw, 0:nlay+1))

      endif
          
      allocate (totufluxd(ncol, 0:nlay+1))     ! upward longwave flux (w/m2)
      allocate (totdfluxd(ncol, 0:nlay+1))     ! downward longwave flux (w/m2)
      allocate (fnetd(ncol, 0:nlay+1))         ! net longwave flux (w/m2)
      allocate (htrd(ncol, 0:nlay+1))          ! longwave heating rate (k/day)
      allocate (totuclfld(ncol, 0:nlay+1))     ! clear sky upward longwave flux (w/m2)
      allocate (totdclfld(ncol, 0:nlay+1))     ! clear sky downward longwave flux (w/m2)
      allocate (fnetcd(ncol, 0:nlay+1))        ! clear sky net longwave flux (w/m2)
      allocate (htrcd(ncol, 0:nlay+1))         ! clear sky longwave heating rate (k/day)
      allocate (dtotuflux_dtd(ncol, 0:nlay+1)) ! change in upward longwave flux (w/m2/k)
      allocate (dtotuclfl_dtd(ncol, 0:nlay+1))
      allocate (dplankbnd_dtd(ncol,nbndlw)) 
#endif

      end subroutine 

! (dmb 2012) This subroutine deallocates rtrnmc related GPU arrays.

      subroutine deallocateGPUrtrnmcg( drvf ) 1

      integer , intent(in) :: drvf
          
#ifdef _ACCEL
      deallocate( taucmcd)
      deallocate( pzd)
      deallocate( pwvcmd)
      deallocate( semissd)
      deallocate( planklayd)
      deallocate( planklevd)
      deallocate( plankbndd)
      deallocate ( gurad)        ! upward longwave flux (w/m2)
      deallocate ( gdrad)        ! downward longwave flux (w/m2)
      deallocate ( gclrurad)     ! clear sky upward longwave flux (w/m2)
      deallocate ( gclrdrad)     ! clear sky downward longwave flux (w/m2)
      deallocate (totufluxd)     ! upward longwave flux (w/m2)
      deallocate (totdfluxd)     ! downward longwave flux (w/m2)
      deallocate (fnetd)         ! net longwave flux (w/m2)
      deallocate (htrd)          ! longwave heating rate (k/day)
      deallocate (totuclfld)     ! clear sky upward longwave flux (w/m2)
      deallocate (totdclfld)     ! clear sky downward longwave flux (w/m2)
      deallocate (fnetcd)        ! clear sky net longwave flux (w/m2)
      deallocate (htrcd)         ! clear sky longwave heating rate (k/day)
      deallocate (dtotuflux_dtd) ! change in upward longwave flux (w/m2/k)
      deallocate (dtotuclfl_dtd)
      deallocate (dplankbnd_dtd) 

      if ( drvf .eq. 1) then
        deallocate( gdtotuflux_dtd, gdtotuclfl_dtd )
      end if
#endif

      end subroutine 

      end module gpu_rrtmg_lw_rtrnmc


! (dmb 2012) This is the GPU version of the taumol subroutines.  At first I was going to 
! try and combine the taumol routines into a single subroutine, but it turns out that 
! all 16 can remain and run efficiently on the GPU.  

      module gpu_rrtmg_lw_taumol 2,7

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! ------- Modules -------

!      use parkind, only : im => kind , rb => kind  
      use parrrtm_f, only : mg, nbndlw, maxxsec, ngptlw
      use rrlw_con_f, only: oneminus
      use rrlw_wvn_f, only: nspa, nspb
      use rrlw_vsn_f, only: hvrtau, hnamtau
      use rrlw_wvn_f, only: ngb
      use rrlw_ref_f
      use memory
 
#ifdef _ACCEL
      use cudafor
#endif

      implicit none

#ifdef _ACCEL
! (dmb 2012) There are a lot of GPU module level variables in this module
! The parameter list for the taumol subroutines have been reduced for 
! efficiency and readability.
! (jm 2014) not thread-safe
      real  _gpudev, allocatable :: pavel(:,:)
      real  _gpudev, allocatable :: wx1(:,:)
      real  _gpudev, allocatable :: wx2(:,:)
      real  _gpudev, allocatable :: wx3(:,:)
      real  _gpudev, allocatable :: wx4(:,:)
      real  _gpudev, allocatable :: coldry(:,:)
      integer  _gpudev, allocatable :: laytrop(:)
      integer  _gpudev, allocatable :: jp(:,:)
      integer  _gpudev, allocatable :: jt(:,:)
      integer  _gpudev, allocatable :: jt1(:,:)
      real  _gpudev, allocatable :: colh2o(:,:)
      real  _gpudev, allocatable :: colco2(:,:)
      real  _gpudev, allocatable :: colo3(:,:)
      real  _gpudev, allocatable :: coln2o(:,:)
      real  _gpudev, allocatable :: colco(:,:)
      real  _gpudev, allocatable :: colch4(:,:)
      real  _gpudev, allocatable :: colo2(:,:)
      real  _gpudev, allocatable :: colbrd(:,:)
      integer  _gpudev, allocatable :: indself(:,:)
      integer  _gpudev, allocatable :: indfor(:,:)
      real  _gpudev, allocatable :: selffac(:,:)
      real  _gpudev, allocatable :: selffrac(:,:)
      real  _gpudev, allocatable :: forfac(:,:)
      real  _gpudev, allocatable :: forfrac(:,:)
      integer  _gpudev, allocatable :: indminor(:,:)
      real  _gpudev, allocatable :: minorfrac(:,:)
      real  _gpudev, allocatable :: scaleminor(:,:)
      real  _gpudev, allocatable :: scaleminorn2(:,:)
      real  _gpudev, allocatable :: fac00(:,:), fac01(:,:), fac10(:,:), fac11(:,:)
      real  _gpudev, allocatable :: rat_h2oco2(:,:),rat_h2oco2_1(:,:), &
                                            rat_h2oo3(:,:),rat_h2oo3_1(:,:), &
                                            rat_h2on2o(:,:),rat_h2on2o_1(:,:), &
                                            rat_h2och4(:,:),rat_h2och4_1(:,:), &
                                            rat_n2oco2(:,:),rat_n2oco2_1(:,:), &
                                            rat_o3co2(:,:),rat_o3co2_1(:,:)
                                                      !    Dimensions: (ncol,nlayers)
      real  _gpudev, allocatable :: tauaa(:,:,:)
                                                      !    Dimensions: (ncol,nlayers,ngptlw)
     
      integer  _gpudev, allocatable :: nspad(:)
      integer  _gpudev, allocatable :: nspbd(:)
      real  _gpucon :: oneminusd 
!$OMP THREADPRIVATE( pavel,wx1,wx2,wx3,wx4,coldry,laytrop,jp,jt,jt1,colh2o,colco2,colo3,coln2o, &
!$OMP                colco,colch4,colo2,colbrd,indself,indfor,selffac,selffrac,forfac,forfrac,  &
!$OMP                indminor,minorfrac,scaleminor,scaleminorn2,fac00,fac01,fac10,fac11,        &
!$OMP                rat_h2oco2,rat_h2oco2_1,rat_h2oo3,rat_h2oo3_1,rat_h2on2o,rat_h2on2o_1,     &
!$OMP                rat_h2och4,rat_h2och4_1,rat_n2oco2,rat_n2oco2_1,rat_o3co2,rat_o3co2_1,     &
!$OMP                tauaa,nspad,nspbd,oneminusd )
#endif

      contains

#ifndef _ACCEL
!defines for taugb functions

# define absad absa
# define absbd absb
# define absbod absbo
# define ccl4d ccl4
# define ccl4od ccl4o
# define cfc11adjd cfc11adj
# define cfc11adjod cfc11adjo
# define cfc12d cfc12
# define cfc12od cfc12o
# define cfc22adjd cfc22adj
# define cfc22adjod cfc22adjo
# define forrefd forref
# define forrefod forrefo
# define fracrefad fracrefa
# define fracrefaod fracrefao
# define fracrefbd fracrefb
# define fracrefbod fracrefbo
# define kad ka
# define ka_mcod ka_mco
# define ka_mco2d ka_mco2
# define ka_mn2d ka_mn2
# define ka_mn2od ka_mn2o
# define ka_mo2d ka_mo2
# define ka_mo3d ka_mo3
# define kaod kao
# define kao_mcod kao_mco
# define kao_mco2d kao_mco2
# define kao_mn2d kao_mn2
# define kao_mn2od kao_mn2o
# define kao_mo3d kao_mo3
# define kbd kb
# define kb_mco2d kb_mco2
# define kb_mn2d kb_mn2
# define kb_mn2od kb_mn2o
# define kb_mo2d kb_mo2
# define kb_mo3d kb_mo3
# define kbod kbo
# define kbo_mco2d kbo_mco2
# define kbo_mn2od kbo_mn2o
# define kbo_mo3d kbo_mo3
# define selfrefd selfref
# define selfrefod selfrefo

#endif
!----------------------------------------------------------------------------

      _gpuker subroutine taugb1g( ncol, nlayers, taug, fracsd  &,1
#include "taug_cpu_args.h"
                                )

!----------------------------------------------------------------------------

! ------- Modifications -------
!  Written by Eli J. Mlawer, Atmospheric & Environmental Research.
!  Revised by Michael J. Iacono, Atmospheric & Environmental Research.
!
!     band 1:  10-350 cm-1 (low key - h2o; low minor - n2)
!                          (high key - h2o; high minor - n2)
!
!     note: previous versions of rrtm band 1: 
!           10-250 cm-1 (low - h2o; high - h2o)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng1
      use rrlw_kg01_f

! ------- Declarations -------

      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      real  :: pp, corradj, scalen2, tauself, taufor, taun2
      integer , value, intent(in) :: ncol, nlayers
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"

! Local 
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif

! Minor gas mapping levels:
!     lower - n2, p = 142.5490 mbar, t = 215.70 k
!     upper - n2, p = 142.5490 mbar, t = 215.70 k

! Compute the optical depth by interpolating in ln(pressure) and 
! temperature.  Below laytrop, the water vapor self-continuum and
! foreign continuum is interpolated (in temperature) separately.

! Lower atmosphere loop


       if (lay <= laytrop(iplon)) then

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(1) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(1) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)
         pp = pavel(iplon, lay)
         corradj =  1.
         if (pp .lt. 250. ) then
            corradj = 1.  - 0.15  * (250. -pp) / 154.4 
         endif

         scalen2 = colbrd(iplon,lay) * scaleminorn2(iplon,lay)
         do ig = 1, ng1
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) -  forrefd(indf,ig))) 
            taun2 = scalen2*(ka_mn2d(indm,ig) + & 
                 minorfrac(iplon,lay) * (ka_mn2d(indm+1,ig) - ka_mn2d(indm,ig)))
            taug(iplon,lay,ig) = corradj * (colh2o(iplon,lay) * &
                (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) + &
                 fac11(iplon,lay) * absad(ind1+1,ig)) & 
                 + tauself + taufor + taun2)
             fracsd(iplon,lay,ig) = fracrefad(ig)
            
         enddo
      else

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(1) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(1) + 1
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)
         pp = pavel(iplon, lay)
         corradj =  1.  - 0.15  * (pp / 95.6 )

         scalen2 = colbrd(iplon,lay) * scaleminorn2(iplon,lay)
         do ig = 1, ng1
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + &
                 forfrac(iplon,lay) * (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            taun2 = scalen2*(kb_mn2d(indm,ig) + & 
                 minorfrac(iplon,lay) * (kb_mn2d(indm+1,ig) - kb_mn2d(indm,ig)))
            taug(iplon,lay,ig) = corradj * (colh2o(iplon,lay) * &
                (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig)) &  
                 + taufor + taun2)
            fracsd(iplon,lay,ig) = fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb1g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb2g( ncol, nlayers , taug, fracsd &,2
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
!
!     note: previous version of rrtm band 2: 
!           250 - 500 cm-1 (low - h2o; high - h2o)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng2, ngs1
      use parrrtm_f, only : ngs1
      use rrlw_kg02_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, ig
      real  :: pp, corradj, tauself, taufor
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Compute the optical depth by interpolating in ln(pressure) and 
! temperature.  Below laytrop, the water vapor self-continuum and
! foreign continuum is interpolated (in temperature) separately.

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(2) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(2) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         pp = pavel(iplon, lay)
         corradj = 1.  - .05  * (pp - 100. ) / 900. 
         do ig = 1, ng2
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            taug(iplon,lay,ngs1+ig) = corradj * (colh2o(iplon,lay) * &
                (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) + &
                 fac11(iplon,lay) * absad(ind1+1,ig)) &
                 + tauself + taufor)
            fracsd(iplon,lay,ngs1+ig) = fracrefad(ig)
         enddo
      else

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(2) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(2) + 1
         indf = indfor(iplon,lay)
         do ig = 1, ng2
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + &
                 forfrac(iplon,lay) * (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            taug(iplon,lay,ngs1+ig) = colh2o(iplon,lay) * &
                (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig)) &
                 + taufor
            fracsd(iplon,lay,ngs1+ig) = fracrefbd(ig)
         enddo
      endif
      
#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb2g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb3g( ncol, nlayers, taug, fracsd &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
!                           (high key - h2o,co2; high minor - n2o)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng3, ngs2
      use parrrtm_f, only : ngs2
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg03_f

! ------- Declarations -------
#include "taug_cpu_defs.h"

! Local 
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
     
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      integer  :: js, js1, jmn2o, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_mn2o, specparm_mn2o, specmult_mn2o, &
                       fmn2o, fmn2omf, chi_n2o, ratn2o, adjfac, adjcoln2o
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor, n2om1, n2om2, absn2o
      real  :: refrat_planck_a, refrat_planck_b, refrat_m_a, refrat_m_b
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping levels:
!     lower - n2o, p = 706.272 mbar, t = 278.94 k
!     upper - n2o, p = 95.58 mbar, t = 215.7 k

!  P = 212.725 mb
      refrat_planck_a = chi_mlsd(1,9)/chi_mlsd(2,9)

!  P = 95.58 mb
      refrat_planck_b = chi_mlsd(1,13)/chi_mlsd(2,13)

!  P = 706.270mb
      refrat_m_a = chi_mlsd(1,3)/chi_mlsd(2,3)

!  P = 95.58 mb 
      refrat_m_b = chi_mlsd(1,13)/chi_mlsd(2,13)

! Compute the optical depth by interpolating in ln(pressure) and 
! temperature, and appropriate species.  Below laytrop, the water vapor 
! self-continuum and foreign continuum is interpolated (in temperature) 
! separately.

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = colh2o(iplon,lay) + rat_h2oco2(iplon,lay)*colco2(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )        

         speccomb1 = colh2o(iplon,lay) + rat_h2oco2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_mn2o = colh2o(iplon,lay) + refrat_m_a*colco2(iplon,lay)
         specparm_mn2o = colh2o(iplon,lay)/speccomb_mn2o
         if (specparm_mn2o .ge. oneminusd) specparm_mn2o = oneminusd
         specmult_mn2o = 8. *specparm_mn2o
         jmn2o = 1 + int(specmult_mn2o)
         fmn2o = mod(specmult_mn2o,1.0 )
         fmn2omf = minorfrac(iplon,lay)*fmn2o
!  In atmospheres where the amount of N2O is too great to be considered
!  a minor species, adjust the column amount of N2O by an empirical factor 
!  to obtain the proper contribution.
         chi_n2o = coln2o(iplon,lay)/coldry(iplon,lay)
         ratn2o = 1.e20 *chi_n2o/chi_mlsd(4,jp(iplon,lay)+1)
         if (ratn2o .gt. 1.5 ) then
            adjfac = 0.5 +(ratn2o-0.5 )**0.65 
            adjcoln2o = adjfac*chi_mlsd(4,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcoln2o = coln2o(iplon,lay)
         endif

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colco2(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(3) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(3) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif
         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng3
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            n2om1 = ka_mn2od(jmn2o,indm,ig) + fmn2o * &
                 (ka_mn2od(jmn2o+1,indm,ig) - ka_mn2od(jmn2o,indm,ig))
            n2om2 = ka_mn2od(jmn2o,indm+1,ig) + fmn2o * &
                 (ka_mn2od(jmn2o+1,indm+1,ig) - ka_mn2od(jmn2o,indm+1,ig))
            absn2o = n2om1 + minorfrac(iplon,lay) * (n2om2 - n2om1)

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) +  &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs2+ig) = tau_major + tau_major1 &
                 + tauself + taufor &
                 + adjcoln2o*absn2o
            fracsd(iplon,lay,ngs2+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
    

! Upper atmosphere loop
      else

         speccomb = colh2o(iplon,lay) + rat_h2oco2(iplon,lay)*colco2(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 4. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2oco2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 4. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         fac000 = (1.  - fs) * fac00(iplon,lay)
         fac010 = (1.  - fs) * fac10(iplon,lay)
         fac100 = fs * fac00(iplon,lay)
         fac110 = fs * fac10(iplon,lay)
         fac001 = (1.  - fs1) * fac01(iplon,lay)
         fac011 = (1.  - fs1) * fac11(iplon,lay)
         fac101 = fs1 * fac01(iplon,lay)
         fac111 = fs1 * fac11(iplon,lay)

         speccomb_mn2o = colh2o(iplon,lay) + refrat_m_b*colco2(iplon,lay)
         specparm_mn2o = colh2o(iplon,lay)/speccomb_mn2o
         if (specparm_mn2o .ge. oneminusd) specparm_mn2o = oneminusd
         specmult_mn2o = 4. *specparm_mn2o
         jmn2o = 1 + int(specmult_mn2o)
         fmn2o = mod(specmult_mn2o,1.0 )
         fmn2omf = minorfrac(iplon,lay)*fmn2o
!  In atmospheres where the amount of N2O is too great to be considered
!  a minor species, adjust the column amount of N2O by an empirical factor 
!  to obtain the proper contribution.
         chi_n2o = coln2o(iplon,lay)/coldry(iplon,lay)
         ratn2o = 1.e20*chi_n2o/chi_mlsd(4,jp(iplon,lay)+1)
         if (ratn2o .gt. 1.5 ) then
            adjfac = 0.5 +(ratn2o-0.5 )**0.65 
            adjcoln2o = adjfac*chi_mlsd(4,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcoln2o = coln2o(iplon,lay)
         endif

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_b*colco2(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 4. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(3) + js
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(3) + js1
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         do ig = 1, ng3
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + &
                 forfrac(iplon,lay) * (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            n2om1 = kb_mn2od(jmn2o,indm,ig) + fmn2o * &
                 (kb_mn2od(jmn2o+1,indm,ig)-kb_mn2od(jmn2o,indm,ig))
            n2om2 = kb_mn2od(jmn2o,indm+1,ig) + fmn2o * &
                 (kb_mn2od(jmn2o+1,indm+1,ig)-kb_mn2od(jmn2o,indm+1,ig))
            absn2o = n2om1 + minorfrac(iplon,lay) * (n2om2 - n2om1)
            taug(iplon,lay,ngs2+ig) = speccomb * &
                (fac000 * absbd(ind0,ig) + &
                fac100 * absbd(ind0+1,ig) + &
                fac010 * absbd(ind0+5,ig) + &
                fac110 * absbd(ind0+6,ig)) &
                + speccomb1 * &
                (fac001 * absbd(ind1,ig) +  &
                fac101 * absbd(ind1+1,ig) + &
                fac011 * absbd(ind1+5,ig) + &
                fac111 * absbd(ind1+6,ig))  &
                + taufor &
                + adjcoln2o*absn2o
            fracsd(iplon,lay,ngs2+ig) = fracrefbd(ig,jpl) + fpl * &
                (fracrefbd(ig,jpl+1)-fracrefbd(ig,jpl))
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb3g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb4g( ncol, nlayers, taug, fracsd  &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 4:  630-700 cm-1 (low key - h2o,co2; high key - o3,co2)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng4, ngs3
      use parrrtm_f, only : ngs3
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg04_f

! ------- Declarations -------
#include "taug_cpu_defs.h"

! Local 
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
     
      
      integer  :: lay, ind0, ind1, inds, indf, ig
      integer  :: js, js1, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor
      real  :: refrat_planck_a, refrat_planck_b
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
        iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif 
! P =   142.5940 mb
      refrat_planck_a = chi_mlsd(1,11)/chi_mlsd(2,11)

! P = 95.58350 mb
      refrat_planck_b = chi_mlsd(3,13)/chi_mlsd(2,13)

! Compute the optical depth by interpolating in ln(pressure) and 
! temperature, and appropriate species.  Below laytrop, the water 
! vapor self-continuum and foreign continuum is interpolated (in temperature) 
! separately.

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = colh2o(iplon,lay) + rat_h2oco2(iplon,lay)*colco2(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2oco2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colco2(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(4) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(4) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif

         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng4
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) +  &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs3+ig) = tau_major + tau_major1 &
                 + tauself + taufor
            fracsd(iplon,lay,ngs3+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
    

! Upper atmosphere loop
      else

         speccomb = colo3(iplon,lay) + rat_o3co2(iplon,lay)*colco2(iplon,lay)
         specparm = colo3(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 4. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colo3(iplon,lay) + rat_o3co2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colo3(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 4. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         fac000 = (1.  - fs) * fac00(iplon,lay)
         fac010 = (1.  - fs) * fac10(iplon,lay)
         fac100 = fs * fac00(iplon,lay)
         fac110 = fs * fac10(iplon,lay)
         fac001 = (1.  - fs1) * fac01(iplon,lay)
         fac011 = (1.  - fs1) * fac11(iplon,lay)
         fac101 = fs1 * fac01(iplon,lay)
         fac111 = fs1 * fac11(iplon,lay)

         speccomb_planck = colo3(iplon,lay)+refrat_planck_b*colco2(iplon,lay)
         specparm_planck = colo3(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 4. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(4) + js
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(4) + js1

         do ig = 1, ng4
            taug(iplon,lay,ngs3+ig) =  speccomb * &
                (fac000 * absbd(ind0,ig) + &
                fac100 * absbd(ind0+1,ig) + &
                fac010 * absbd(ind0+5,ig) + &
                fac110 * absbd(ind0+6,ig)) &
                + speccomb1 * &
                (fac001 * absbd(ind1,ig) +  &
                fac101 * absbd(ind1+1,ig) + &
                fac011 * absbd(ind1+5,ig) + &
                fac111 * absbd(ind1+6,ig))
            fracsd(iplon,lay,ngs3+ig) = fracrefbd(ig,jpl) + fpl * &
                (fracrefbd(ig,jpl+1)-fracrefbd(ig,jpl))
         enddo

! Empirical modification to code to improve stratospheric cooling rates
! for co2.  Revised to apply weighting for g-point reduction in this band.

         taug(iplon,lay,ngs3+8)=taug(iplon,lay,ngs3+8)*0.92
         taug(iplon,lay,ngs3+9)=taug(iplon,lay,ngs3+9)*0.88
         taug(iplon,lay,ngs3+10)=taug(iplon,lay,ngs3+10)*1.07
         taug(iplon,lay,ngs3+11)=taug(iplon,lay,ngs3+11)*1.1
         taug(iplon,lay,ngs3+12)=taug(iplon,lay,ngs3+12)*0.99
         taug(iplon,lay,ngs3+13)=taug(iplon,lay,ngs3+13)*0.88
         taug(iplon,lay,ngs3+14)=taug(iplon,lay,ngs3+14)*0.943

      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb4g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb5g( ncol, nlayers , taug, fracsd &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
!                           (high key - o3,co2)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng5, ngs4
      use parrrtm_f, only : ngs4
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg05_f

! ------- Declarations -------
#include "taug_cpu_defs.h"

! Local 
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
     
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      integer  :: js, js1, jmo3, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_mo3, specparm_mo3, specmult_mo3, fmo3
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor, o3m1, o3m2, abso3
      real  :: refrat_planck_a, refrat_planck_b, refrat_m_a
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level :
!     lower - o3, p = 317.34 mbar, t = 240.77 k
!     lower - ccl4

! Calculate reference ratio to be used in calculation of Planck
! fraction in lower/upper atmosphere.

! P = 473.420 mb
      refrat_planck_a = chi_mlsd(1,5)/chi_mlsd(2,5)

! P = 0.2369 mb
      refrat_planck_b = chi_mlsd(3,43)/chi_mlsd(2,43)

! P = 317.3480
      refrat_m_a = chi_mlsd(1,7)/chi_mlsd(2,7)

! Compute the optical depth by interpolating in ln(pressure) and 
! temperature, and appropriate species.  Below laytrop, the 
! water vapor self-continuum and foreign continuum is 
! interpolated (in temperature) separately.

! Lower atmosphere loop
      !do lay = 1, laytrop(iplon)
      if (lay <= laytrop(iplon)) then
         speccomb = colh2o(iplon,lay) + rat_h2oco2(iplon,lay)*colco2(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2oco2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_mo3 = colh2o(iplon,lay) + refrat_m_a*colco2(iplon,lay)
         specparm_mo3 = colh2o(iplon,lay)/speccomb_mo3
         if (specparm_mo3 .ge. oneminusd) specparm_mo3 = oneminusd
         specmult_mo3 = 8. *specparm_mo3
         jmo3 = 1 + int(specmult_mo3)
         fmo3 = mod(specmult_mo3,1.0 )

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colco2(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(5) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(5) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif

         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng5
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            o3m1 = ka_mo3d(jmo3,indm,ig) + fmo3 * &
                 (ka_mo3d(jmo3+1,indm,ig)-ka_mo3d(jmo3,indm,ig))
            o3m2 = ka_mo3d(jmo3,indm+1,ig) + fmo3 * &
                 (ka_mo3d(jmo3+1,indm+1,ig)-ka_mo3d(jmo3,indm+1,ig))
            abso3 = o3m1 + minorfrac(iplon,lay)*(o3m2-o3m1)

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * & 
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs4+ig) = tau_major + tau_major1 &
                 + tauself + taufor &
                 + abso3*colo3(iplon,lay) &
                 + wx1(iplon,lay) * coldry(iplon,lay) * 1.e-20  * ccl4d(ig)
            fracsd(iplon,lay,ngs4+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
      else

! Upper atmosphere loop
      !do lay = laytrop(iplon)+1, nlayers

         speccomb = colo3(iplon,lay) + rat_o3co2(iplon,lay)*colco2(iplon,lay)
         specparm = colo3(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 4. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colo3(iplon,lay) + rat_o3co2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colo3(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 4. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         fac000 = (1.  - fs) * fac00(iplon,lay)
         fac010 = (1.  - fs) * fac10(iplon,lay)
         fac100 = fs * fac00(iplon,lay)
         fac110 = fs * fac10(iplon,lay)
         fac001 = (1.  - fs1) * fac01(iplon,lay)
         fac011 = (1.  - fs1) * fac11(iplon,lay)
         fac101 = fs1 * fac01(iplon,lay)
         fac111 = fs1 * fac11(iplon,lay)

         speccomb_planck = colo3(iplon,lay)+refrat_planck_b*colco2(iplon,lay)
         specparm_planck = colo3(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 4. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(5) + js
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(5) + js1
         
         do ig = 1, ng5
            taug(iplon,lay,ngs4+ig) = speccomb * &
                (fac000 * absbd(ind0,ig) + &
                fac100 * absbd(ind0+1,ig) + &
                fac010 * absbd(ind0+5,ig) + &
                fac110 * absbd(ind0+6,ig)) &
                + speccomb1 * &
                (fac001 * absbd(ind1,ig) + &
                fac101 * absbd(ind1+1,ig) + &
                fac011 * absbd(ind1+5,ig) + &
                fac111 * absbd(ind1+6,ig))  &
                + wx1(iplon, lay) * coldry(iplon,lay) * 1.e-20  * ccl4d(ig)
            fracsd(iplon,lay,ngs4+ig) = fracrefbd(ig,jpl) + fpl * &
                (fracrefbd(ig,jpl+1)-fracrefbd(ig,jpl))
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb5g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb6g( ncol, nlayers, taug, fracsd &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 6:  820-980 cm-1 (low key - h2o; low minor - co2)
!                           (high key - nothing; high minor - cfc11, cfc12)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng6, ngs5
      use parrrtm_f, only : ngs5
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg06_f

! ------- Declarations -------
#include "taug_cpu_defs.h"

! Local 
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      real  :: chi_co2, ratco2, adjfac, adjcolco2
      real  :: tauself, taufor, absco2
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
     
#ifdef _ACCEL
        iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level:
!     lower - co2, p = 706.2720 mb, t = 294.2 k
!     upper - cfc11, cfc12

! Compute the optical depth by interpolating in ln(pressure) and
! temperature. The water vapor self-continuum and foreign continuum
! is interpolated (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

! In atmospheres where the amount of CO2 is too great to be considered
! a minor species, adjust the column amount of CO2 by an empirical factor 
! to obtain the proper contribution.
         chi_co2 = colco2(iplon,lay)/(coldry(iplon,lay))
         ratco2 = 1.e20 *chi_co2/chi_mlsd(2,jp(iplon,lay)+1)
         if (ratco2 .gt. 3.0 ) then
            adjfac = 2.0 +(ratco2-2.0 )**0.77 
            adjcolco2 = adjfac*chi_mlsd(2,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcolco2 = colco2(iplon,lay)
         endif

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(6) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(6) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         do ig = 1, ng6
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig)))
            absco2 =  (ka_mco2d(indm,ig) + minorfrac(iplon,lay) * &
                 (ka_mco2d(indm+1,ig) - ka_mco2d(indm,ig)))
            taug(iplon,lay,ngs5+ig) = colh2o(iplon,lay) * &
                (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) +  &
                 fac11(iplon,lay) * absad(ind1+1,ig))  &
                 + tauself + taufor &
                 + adjcolco2 * absco2 &
                 + wx2(iplon, lay) * coldry(iplon,lay) * 1.e-20  * cfc11adjd(ig) &
                 + wx3(iplon, lay) * coldry(iplon,lay) * 1.e-20  * cfc12d(ig)
            fracsd(iplon,lay,ngs5+ig) = fracrefad(ig)
         enddo
      else

         do ig = 1, ng6
            taug(iplon,lay,ngs5+ig) = 0.0  &
                 + wx2(iplon, lay) * coldry(iplon,lay) * 1.e-20   * cfc11adjd(ig) &
                 + wx3(iplon, lay) * coldry(iplon,lay) * 1.e-20  * cfc12d(ig)
            fracsd(iplon,lay,ngs5+ig) = fracrefad(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb6g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb7g( ncol, nlayers , taug, fracsd &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
!                            (high key - o3; high minor - co2)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng7, ngs6
      use parrrtm_f, only : ngs6
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg07_f

! ------- Declarations -------
#include "taug_cpu_defs.h"

! Local 
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
     
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      integer  :: js, js1, jmco2, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_mco2, specparm_mco2, specmult_mco2, fmco2
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor, co2m1, co2m2, absco2
      real  :: chi_co2, ratco2, adjfac, adjcolco2
      real  :: refrat_planck_a, refrat_m_a
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level :
!     lower - co2, p = 706.2620 mbar, t= 278.94 k
!     upper - co2, p = 12.9350 mbar, t = 234.01 k

! Calculate reference ratio to be used in calculation of Planck
! fraction in lower atmosphere.

! P = 706.2620 mb
      refrat_planck_a = chi_mlsd(1,3)/chi_mlsd(3,3)

! P = 706.2720 mb
      refrat_m_a = chi_mlsd(1,3)/chi_mlsd(3,3)

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below laytrop, the water
! vapor self-continuum and foreign continuum is interpolated 
! (in temperature) separately. 

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = colh2o(iplon,lay) + rat_h2oo3(iplon,lay)*colo3(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2oo3_1(iplon,lay)*colo3(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_mco2 = colh2o(iplon,lay) + refrat_m_a*colo3(iplon,lay)
         specparm_mco2 = colh2o(iplon,lay)/speccomb_mco2
         if (specparm_mco2 .ge. oneminusd) specparm_mco2 = oneminusd
         specmult_mco2 = 8. *specparm_mco2

         jmco2 = 1 + int(specmult_mco2)
         fmco2 = mod(specmult_mco2,1.0 )

!  In atmospheres where the amount of CO2 is too great to be considered
!  a minor species, adjust the column amount of CO2 by an empirical factor 
!  to obtain the proper contribution.
         chi_co2 = colco2(iplon,lay)/(coldry(iplon,lay))
         ratco2 = 1.e20*chi_co2/chi_mlsd(2,jp(iplon,lay)+1)
         if (ratco2 .gt. 3.0 ) then
            adjfac = 3.0 +(ratco2-3.0 )**0.79 
            adjcolco2 = adjfac*chi_mlsd(2,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcolco2 = colco2(iplon,lay)
         endif

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colo3(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(7) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(7) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif
         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng7
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            co2m1 = ka_mco2d(jmco2,indm,ig) + fmco2 * &
                 (ka_mco2d(jmco2+1,indm,ig) - ka_mco2d(jmco2,indm,ig))
            co2m2 = ka_mco2d(jmco2,indm+1,ig) + fmco2 * &
                 (ka_mco2d(jmco2+1,indm+1,ig) - ka_mco2d(jmco2,indm+1,ig))
            absco2 = co2m1 + minorfrac(iplon,lay) * (co2m2 - co2m1)

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) +  &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs6+ig) = tau_major + tau_major1 &
                 + tauself + taufor &
                 + adjcolco2*absco2
            fracsd(iplon,lay,ngs6+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
    else
!  In atmospheres where the amount of CO2 is too great to be considered
!  a minor species, adjust the column amount of CO2 by an empirical factor 
!  to obtain the proper contribution.
         chi_co2 = colco2(iplon,lay)/(coldry(iplon,lay))
         ratco2 = 1.e20*chi_co2/chi_mlsd(2,jp(iplon,lay)+1)
         if (ratco2 .gt. 3.0 ) then
            adjfac = 2.0 +(ratco2-2.0 )**0.79 
            adjcolco2 = adjfac*chi_mlsd(2,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcolco2 = colco2(iplon,lay)
         endif

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(7) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(7) + 1
         indm = indminor(iplon,lay)

         do ig = 1, ng7
            absco2 = kb_mco2d(indm,ig) + minorfrac(iplon,lay) * &
                 (kb_mco2d(indm+1,ig) - kb_mco2d(indm,ig))
            taug(iplon,lay,ngs6+ig) = colo3(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig)) &
                 + adjcolco2 * absco2
            fracsd(iplon,lay,ngs6+ig) = fracrefbd(ig)
         enddo

! Empirical modification to code to improve stratospheric cooling rates
! for o3.  Revised to apply weighting for g-point reduction in this band.

         taug(iplon,lay,ngs6+6)=taug(iplon,lay,ngs6+6)*0.92 
         taug(iplon,lay,ngs6+7)=taug(iplon,lay,ngs6+7)*0.88 
         taug(iplon,lay,ngs6+8)=taug(iplon,lay,ngs6+8)*1.07 
         taug(iplon,lay,ngs6+9)=taug(iplon,lay,ngs6+9)*1.1 
         taug(iplon,lay,ngs6+10)=taug(iplon,lay,ngs6+10)*0.99 
         taug(iplon,lay,ngs6+11)=taug(iplon,lay,ngs6+11)*0.855 

      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb7g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb8g( ncol, nlayers, taug, fracsd  &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 8:  1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
!                             (high key - o3; high minor - co2, n2o)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng8, ngs7
      use parrrtm_f, only : ngs7
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg08_f

! ------- Declarations -------
#include "taug_cpu_defs.h"

! Local  
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
     
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      real  :: tauself, taufor, absco2, abso3, absn2o
      real  :: chi_co2, ratco2, adjfac, adjcolco2
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level:
!     lower - co2, p = 1053.63 mb, t = 294.2 k
!     lower - o3,  p = 317.348 mb, t = 240.77 k
!     lower - n2o, p = 706.2720 mb, t= 278.94 k
!     lower - cfc12,cfc11
!     upper - co2, p = 35.1632 mb, t = 223.28 k
!     upper - n2o, p = 8.716e-2 mb, t = 226.03 k

! Compute the optical depth by interpolating in ln(pressure) and 
! temperature, and appropriate species.  Below laytrop, the water vapor 
! self-continuum and foreign continuum is interpolated (in temperature) 
! separately.

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

!  In atmospheres where the amount of CO2 is too great to be considered
!  a minor species, adjust the column amount of CO2 by an empirical factor 
!  to obtain the proper contribution.
         chi_co2 = colco2(iplon,lay)/(coldry(iplon,lay))
         ratco2 = 1.e20 *chi_co2/chi_mlsd(2,jp(iplon,lay)+1)
         if (ratco2 .gt. 3.0 ) then
            adjfac = 2.0 +(ratco2-2.0 )**0.65 
            adjcolco2 = adjfac*chi_mlsd(2,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcolco2 = colco2(iplon,lay)
         endif

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(8) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(8) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         do ig = 1, ng8
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig)))
            absco2 =  (ka_mco2d(indm,ig) + minorfrac(iplon,lay) * &
                 (ka_mco2d(indm+1,ig) - ka_mco2d(indm,ig)))
            abso3 =  (ka_mo3d(indm,ig) + minorfrac(iplon,lay) * &
                 (ka_mo3d(indm+1,ig) - ka_mo3d(indm,ig)))
            absn2o =  (ka_mn2od(indm,ig) + minorfrac(iplon,lay) * &
                 (ka_mn2od(indm+1,ig) - ka_mn2od(indm,ig)))
            taug(iplon,lay,ngs7+ig) = colh2o(iplon,lay) * &
                 (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) +  &
                 fac11(iplon,lay) * absad(ind1+1,ig)) &
                 + tauself + taufor &
                 + adjcolco2*absco2 &
                 + colo3(iplon,lay) * abso3 &
                 + coln2o(iplon,lay) * absn2o &
                 + wx3(iplon, lay) * coldry(iplon,lay) * 1.e-20  * cfc12d(ig) &
                 + wx4(iplon, lay) * coldry(iplon,lay) * 1.e-20  * cfc22adjd(ig)
            fracsd(iplon,lay,ngs7+ig) = fracrefad(ig)
         enddo
      else
!  In atmospheres where the amount of CO2 is too great to be considered
!  a minor species, adjust the column amount of CO2 by an empirical factor 
!  to obtain the proper contribution.
         chi_co2 = colco2(iplon,lay)/coldry(iplon,lay)
         ratco2 = 1.e20 *chi_co2/chi_mlsd(2,jp(iplon,lay)+1)
         if (ratco2 .gt. 3.0 ) then
            adjfac = 2.0 +(ratco2-2.0 )**0.65 
            adjcolco2 = adjfac*chi_mlsd(2,jp(iplon,lay)+1) * coldry(iplon,lay)*1.e-20 
         else
            adjcolco2 = colco2(iplon,lay)
         endif

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(8) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(8) + 1
         indm = indminor(iplon,lay)

         do ig = 1, ng8
            absco2 =  (kb_mco2d(indm,ig) + minorfrac(iplon,lay) * &
                 (kb_mco2d(indm+1,ig) - kb_mco2d(indm,ig)))
            absn2o =  (kb_mn2od(indm,ig) + minorfrac(iplon,lay) * &
                 (kb_mn2od(indm+1,ig) - kb_mn2od(indm,ig)))
            taug(iplon,lay,ngs7+ig) = colo3(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig)) &
                 + adjcolco2*absco2 &
                 + coln2o(iplon,lay)*absn2o & 
                 + wx3(iplon,lay) * coldry(iplon,lay) * 1.e-20  * cfc12d(ig) &
                 + wx4(iplon,lay) * coldry(iplon,lay) * 1.e-20  * cfc22adjd(ig)
            fracsd(iplon,lay,ngs7+ig) = fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb8g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb9g( ncol, nlayers, taug, fracsd &,3
#include "taug_cpu_args.h"
                                )
!----------------------------------------------------------------------------
!
!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
!                             (high key - ch4; high minor - n2o)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng9, ngs8
      use parrrtm_f, only : ngs8
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg09_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      integer  :: js, js1, jmn2o, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor, n2om1, n2om2, absn2o
      real  :: chi_n2o, ratn2o, adjfac, adjcoln2o
      real  :: refrat_planck_a, refrat_m_a
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
        iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level :
!     lower - n2o, p = 706.272 mbar, t = 278.94 k
!     upper - n2o, p = 95.58 mbar, t = 215.7 k

! Calculate reference ratio to be used in calculation of Planck
! fraction in lower/upper atmosphere.

! P = 212 mb
      refrat_planck_a = chi_mlsd(1,9)/chi_mlsd(6,9)

! P = 706.272 mb 
      refrat_m_a = chi_mlsd(1,3)/chi_mlsd(6,3)

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below laytrop, the water
! vapor self-continuum and foreign continuum is interpolated 
! (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = colh2o(iplon,lay) + rat_h2och4(iplon,lay)*colch4(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2och4_1(iplon,lay)*colch4(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_mn2o = colh2o(iplon,lay) + refrat_m_a*colch4(iplon,lay)
         specparm_mn2o = colh2o(iplon,lay)/speccomb_mn2o
         if (specparm_mn2o .ge. oneminusd) specparm_mn2o = oneminusd
         specmult_mn2o = 8. *specparm_mn2o
         jmn2o = 1 + int(specmult_mn2o)
         fmn2o = mod(specmult_mn2o,1.0 )

!  In atmospheres where the amount of N2O is too great to be considered
!  a minor species, adjust the column amount of N2O by an empirical factor 
!  to obtain the proper contribution.
         chi_n2o = coln2o(iplon,lay)/(coldry(iplon,lay))
         ratn2o = 1.e20 *chi_n2o/chi_mlsd(4,jp(iplon,lay)+1)
         if (ratn2o .gt. 1.5 ) then
            adjfac = 0.5 +(ratn2o-0.5 )**0.65 
            adjcoln2o = adjfac*chi_mlsd(4,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcoln2o = coln2o(iplon,lay)
         endif

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colch4(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(9) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(9) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif

         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng9
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            n2om1 = ka_mn2od(jmn2o,indm,ig) + fmn2o * &
                 (ka_mn2od(jmn2o+1,indm,ig) - ka_mn2od(jmn2o,indm,ig))
            n2om2 = ka_mn2od(jmn2o,indm+1,ig) + fmn2o * &
                 (ka_mn2od(jmn2o+1,indm+1,ig) - ka_mn2od(jmn2o,indm+1,ig))
            absn2o = n2om1 + minorfrac(iplon,lay) * (n2om2 - n2om1)

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + & 
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs8+ig) = tau_major + tau_major1 &
                 + tauself + taufor &
                 + adjcoln2o*absn2o
            fracsd(iplon,lay,ngs8+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
      else
!  In atmospheres where the amount of N2O is too great to be considered
!  a minor species, adjust the column amount of N2O by an empirical factor 
!  to obtain the proper contribution.
         chi_n2o = coln2o(iplon,lay)/(coldry(iplon,lay))
         ratn2o = 1.e20 *chi_n2o/chi_mlsd(4,jp(iplon,lay)+1)
         if (ratn2o .gt. 1.5 ) then
            adjfac = 0.5 +(ratn2o-0.5 )**0.65 
            adjcoln2o = adjfac*chi_mlsd(4,jp(iplon,lay)+1)*coldry(iplon,lay)*1.e-20 
         else
            adjcoln2o = coln2o(iplon,lay)
         endif

         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(9) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(9) + 1
         indm = indminor(iplon,lay)

         do ig = 1, ng9
            absn2o = kb_mn2od(indm,ig) + minorfrac(iplon,lay) * &
                (kb_mn2od(indm+1,ig) - kb_mn2od(indm,ig))
            taug(iplon,lay,ngs8+ig) = colch4(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) +  &
                 fac11(iplon,lay) * absbd(ind1+1,ig)) &
                 + adjcoln2o*absn2o
            fracsd(iplon,lay,ngs8+ig) = fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb9g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb10g( ncol, nlayers, taug, fracsd &,2
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 10:  1390-1480 cm-1 (low key - h2o; high key - h2o)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng10, ngs9
      use parrrtm_f, only : ngs9
      use rrlw_kg10_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, ig
      real  :: tauself, taufor
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Compute the optical depth by interpolating in ln(pressure) and 
! temperature.  Below laytrop, the water vapor self-continuum and
! foreign continuum is interpolated (in temperature) separately.

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then
         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(10) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(10) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)

         do ig = 1, ng10
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            taug(iplon,lay,ngs9+ig) = colh2o(iplon,lay) * &
                 (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) + &
                 fac11(iplon,lay) * absad(ind1+1,ig))  &
                 + tauself + taufor
            fracsd(iplon,lay,ngs9+ig) = fracrefad(ig)
         enddo
      else
   
         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(10) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(10) + 1
         indf = indfor(iplon,lay)

         do ig = 1, ng10
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            taug(iplon,lay,ngs9+ig) = colh2o(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) +  &
                 fac11(iplon,lay) * absbd(ind1+1,ig)) &
                 + taufor
            fracsd(iplon,lay,ngs9+ig) = fracrefbd(ig)
         enddo
      end if

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif
      end subroutine taugb10g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb11g( ncol, nlayers, taug, fracsd &,2
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
!                              (high key - h2o; high minor - o2)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng11, ngs10
      use parrrtm_f, only : ngs10
      use rrlw_kg11_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      real  :: scaleo2, tauself, taufor, tauo2
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level :
!     lower - o2, p = 706.2720 mbar, t = 278.94 k
!     upper - o2, p = 4.758820 mbarm t = 250.85 k

! Compute the optical depth by interpolating in ln(pressure) and 
! temperature.  Below laytrop, the water vapor self-continuum and
! foreign continuum is interpolated (in temperature) separately.

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then
         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(11) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(11) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)
         scaleo2 = colo2(iplon,lay)*scaleminor(iplon,lay)
         do ig = 1, ng11
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig)))
            tauo2 =  scaleo2 * (ka_mo2d(indm,ig) + minorfrac(iplon,lay) * &
                 (ka_mo2d(indm+1,ig) - ka_mo2d(indm,ig)))
            taug(iplon,lay,ngs10+ig) = colh2o(iplon,lay) * &
                 (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) + &
                 fac11(iplon,lay) * absad(ind1+1,ig)) &
                 + tauself + taufor &
                 + tauo2
            fracsd(iplon,lay,ngs10+ig) = fracrefad(ig)
         enddo
      else
         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(11) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(11) + 1
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)
         scaleo2 = colo2(iplon,lay)*scaleminor(iplon,lay)
         do ig = 1, ng11
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            tauo2 =  scaleo2 * (kb_mo2d(indm,ig) + minorfrac(iplon,lay) * &
                 (kb_mo2d(indm+1,ig) - kb_mo2d(indm,ig)))
            taug(iplon,lay,ngs10+ig) = colh2o(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig))  &
                 + taufor &
                 + tauo2
            fracsd(iplon,lay,ngs10+ig) = fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb11g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb12g( ncol, nlayers, taug, fracsd &,3
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng12, ngs11
      use parrrtm_f, only : ngs11
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg12_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, ig
      integer  :: js, js1, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor
      real  :: refrat_planck_a
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Calculate reference ratio to be used in calculation of Planck
! fraction in lower/upper atmosphere.

! P =   174.164 mb 
      refrat_planck_a = chi_mlsd(1,10)/chi_mlsd(2,10)

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below laytrop, the water
! vapor self-continuum adn foreign continuum is interpolated 
! (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = colh2o(iplon,lay) + rat_h2oco2(iplon,lay)*colco2(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2oco2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colco2(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(12) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(12) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif

         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng12
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs11+ig) = tau_major + tau_major1 &
                 + tauself + taufor
            fracsd(iplon,lay,ngs11+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
   
      else
         do ig = 1, ng12
            taug(iplon,lay,ngs11+ig) = 0.0 
            fracsd(iplon,lay,ngs11+ig) = 0.0 
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb12g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb13g( ncol, nlayers, taug, fracsd  &,3
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng13, ngs12
      use parrrtm_f, only : ngs12
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg13_f
! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      integer  :: js, js1, jmco2, jmco, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_mco2, specparm_mco2, specmult_mco2, fmco2
      real  :: speccomb_mco, specparm_mco, specmult_mco, fmco
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor, co2m1, co2m2, absco2 
      real  :: com1, com2, absco, abso3
      real  :: chi_co2, ratco2, adjfac, adjcolco2
      real  :: refrat_planck_a, refrat_m_a, refrat_m_a3
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping levels :
!     lower - co2, p = 1053.63 mb, t = 294.2 k
!     lower - co, p = 706 mb, t = 278.94 k
!     upper - o3, p = 95.5835 mb, t = 215.7 k

! Calculate reference ratio to be used in calculation of Planck
! fraction in lower/upper atmosphere.

! P = 473.420 mb (Level 5)
      refrat_planck_a = chi_mlsd(1,5)/chi_mlsd(4,5)

! P = 1053. (Level 1)
      refrat_m_a = chi_mlsd(1,1)/chi_mlsd(4,1)

! P = 706. (Level 3)
      refrat_m_a3 = chi_mlsd(1,3)/chi_mlsd(4,3)

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below laytrop, the water
! vapor self-continuum and foreign continuum is interpolated 
! (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = colh2o(iplon,lay) + rat_h2on2o(iplon,lay)*coln2o(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2on2o_1(iplon,lay)*coln2o(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_mco2 = colh2o(iplon,lay) + refrat_m_a*coln2o(iplon,lay)
         specparm_mco2 = colh2o(iplon,lay)/speccomb_mco2
         if (specparm_mco2 .ge. oneminusd) specparm_mco2 = oneminusd
         specmult_mco2 = 8. *specparm_mco2
         jmco2 = 1 + int(specmult_mco2)
         fmco2 = mod(specmult_mco2,1.0 )

!  In atmospheres where the amount of CO2 is too great to be considered
!  a minor species, adjust the column amount of CO2 by an empirical factor 
!  to obtain the proper contribution.
         chi_co2 = colco2(iplon,lay)/(coldry(iplon,lay))
         ratco2 = 1.e20 *chi_co2/3.55e-4 
         if (ratco2 .gt. 3.0 ) then
            adjfac = 2.0 +(ratco2-2.0 )**0.68 
            adjcolco2 = adjfac*3.55e-4*coldry(iplon,lay)*1.e-20 
         else
            adjcolco2 = colco2(iplon,lay)
         endif

         speccomb_mco = colh2o(iplon,lay) + refrat_m_a3*coln2o(iplon,lay)
         specparm_mco = colh2o(iplon,lay)/speccomb_mco
         if (specparm_mco .ge. oneminusd) specparm_mco = oneminusd
         specmult_mco = 8. *specparm_mco
         jmco = 1 + int(specmult_mco)
         fmco = mod(specmult_mco,1.0 )

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*coln2o(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(13) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(13) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif

         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng13
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor = forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            co2m1 = ka_mco2d(jmco2,indm,ig) + fmco2 * &
                 (ka_mco2d(jmco2+1,indm,ig) - ka_mco2d(jmco2,indm,ig))
            co2m2 = ka_mco2d(jmco2,indm+1,ig) + fmco2 * &
                 (ka_mco2d(jmco2+1,indm+1,ig) - ka_mco2d(jmco2,indm+1,ig))
            absco2 = co2m1 + minorfrac(iplon,lay) * (co2m2 - co2m1)
            com1 = ka_mcod(jmco,indm,ig) + fmco * &
                 (ka_mcod(jmco+1,indm,ig) - ka_mcod(jmco,indm,ig))
            com2 = ka_mcod(jmco,indm+1,ig) + fmco * &
                 (ka_mcod(jmco+1,indm+1,ig) - ka_mcod(jmco,indm+1,ig))
            absco = com1 + minorfrac(iplon,lay) * (com2 - com1)

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs12+ig) = tau_major + tau_major1 &
                 + tauself + taufor &
                 + adjcolco2*absco2 &
                 + colco(iplon,lay)*absco
            fracsd(iplon,lay,ngs12+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
      else
         indm = indminor(iplon,lay)
         do ig = 1, ng13
            abso3 = kb_mo3d(indm,ig) + minorfrac(iplon,lay) * &
                 (kb_mo3d(indm+1,ig) - kb_mo3d(indm,ig))
            taug(iplon,lay,ngs12+ig) = colo3(iplon,lay)*abso3
            fracsd(iplon,lay,ngs12+ig) =  fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb13g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb14g( ncol, nlayers , taug, fracsd &,2
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 14:  2250-2380 cm-1 (low - co2; high - co2)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng14, ngs13
      use parrrtm_f, only : ngs13
      use rrlw_kg14_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, ig
      real  :: tauself, taufor
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Compute the optical depth by interpolating in ln(pressure) and 
! temperature.  Below laytrop, the water vapor self-continuum 
! and foreign continuum is interpolated (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then
         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(14) + 1
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(14) + 1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         do ig = 1, ng14
            tauself = selffac(iplon,lay) * (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            taug(iplon,lay,ngs13+ig) = colco2(iplon,lay) * &
                 (fac00(iplon,lay) * absad(ind0,ig) + &
                 fac10(iplon,lay) * absad(ind0+1,ig) + &
                 fac01(iplon,lay) * absad(ind1,ig) + &
                 fac11(iplon,lay) * absad(ind1+1,ig)) &
                 + tauself + taufor
            fracsd(iplon,lay,ngs13+ig) = fracrefad(ig)
         enddo
      else
         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(14) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(14) + 1
         do ig = 1, ng14
            taug(iplon,lay,ngs13+ig) = colco2(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig))
            fracsd(iplon,lay,ngs13+ig) = fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb14g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb15g( ncol, nlayers , taug, fracsd &,3
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
!                              (high - nothing)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng15, ngs14
      use parrrtm_f, only : ngs14
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg15_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, indm, ig
      integer  :: js, js1, jmn2, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_mn2, specparm_mn2, specmult_mn2, fmn2
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: scalen2, tauself, taufor, n2m1, n2m2, taun2 
      real  :: refrat_planck_a, refrat_m_a
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif
! Minor gas mapping level : 
!     Lower - Nitrogen Continuum, P = 1053., T = 294.

! Calculate reference ratio to be used in calculation of Planck
! fraction in lower atmosphere.
! P = 1053. mb (Level 1)
      refrat_planck_a = chi_mlsd(4,1)/chi_mlsd(2,1)

! P = 1053.
      refrat_m_a = chi_mlsd(4,1)/chi_mlsd(2,1)

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below laytrop, the water
! vapor self-continuum and foreign continuum is interpolated 
! (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then

         speccomb = coln2o(iplon,lay) + rat_n2oco2(iplon,lay)*colco2(iplon,lay)
         specparm = coln2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = coln2o(iplon,lay) + rat_n2oco2_1(iplon,lay)*colco2(iplon,lay)
         specparm1 = coln2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_mn2 = coln2o(iplon,lay) + refrat_m_a*colco2(iplon,lay)
         specparm_mn2 = coln2o(iplon,lay)/speccomb_mn2
         if (specparm_mn2 .ge. oneminusd) specparm_mn2 = oneminusd
         specmult_mn2 = 8. *specparm_mn2
         jmn2 = 1 + int(specmult_mn2)
         fmn2 = mod(specmult_mn2,1.0 )

         speccomb_planck = coln2o(iplon,lay)+refrat_planck_a*colco2(iplon,lay)
         specparm_planck = coln2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(15) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(15) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         indm = indminor(iplon,lay)
         
         scalen2 = colbrd(iplon,lay)*scaleminor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif
         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng15
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 
            n2m1 = ka_mn2d(jmn2,indm,ig) + fmn2 * &
                 (ka_mn2d(jmn2+1,indm,ig) - ka_mn2d(jmn2,indm,ig))
            n2m2 = ka_mn2d(jmn2,indm+1,ig) + fmn2 * &
                 (ka_mn2d(jmn2+1,indm+1,ig) - ka_mn2d(jmn2,indm+1,ig))
            taun2 = scalen2 * (n2m1 + minorfrac(iplon,lay) * (n2m2 - n2m1))

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif 

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs14+ig) = tau_major + tau_major1 &
                 + tauself + taufor &
                 + taun2
            fracsd(iplon,lay,ngs14+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
    
      else
         do ig = 1, ng15
            taug(iplon,lay,ngs14+ig) = 0.0 
            fracsd(iplon,lay,ngs14+ig) = 0.0 
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb15g

!----------------------------------------------------------------------------

      _gpuker subroutine taugb16g( ncol, nlayers , taug, fracsd &,3
#include "taug_cpu_args.h"
                                 )
!----------------------------------------------------------------------------
!
!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
!----------------------------------------------------------------------------

! ------- Modules -------

!      use parrrtm_f, only : ng16, ngs15
      use parrrtm_f, only : ngs15
      use rrlw_ref_f, only : chi_mlsd
      use rrlw_kg16_f

! ------- Declarations -------
      real  _gpudev :: taug(:,:,:)
      real  _gpudev :: fracsd(:,:,:)
#include "taug_cpu_defs.h"
     
! Local 
      integer  :: lay, ind0, ind1, inds, indf, ig
      integer  :: js, js1, jpl
      real  :: speccomb, specparm, specmult, fs
      real  :: speccomb1, specparm1, specmult1, fs1
      real  :: speccomb_planck, specparm_planck, specmult_planck, fpl
      real  :: p, p4, fk0, fk1, fk2
      real  :: fac000, fac100, fac200, fac010, fac110, fac210
      real  :: fac001, fac101, fac201, fac011, fac111, fac211
      real  :: tauself, taufor
      real  :: refrat_planck_a
      real  :: tau_major, tau_major1
      integer , value, intent(in) :: ncol, nlayers
      integer  :: iplon

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      if (iplon <= ncol .and. lay <= nlayers) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
#endif 
! Calculate reference ratio to be used in calculation of Planck
! fraction in lower atmosphere.

! P = 387. mb (Level 6)
      refrat_planck_a = chi_mlsd(1,6)/chi_mlsd(6,6)

! Compute the optical depth by interpolating in ln(pressure), 
! temperature,and appropriate species.  Below laytrop, the water
! vapor self-continuum and foreign continuum is interpolated 
! (in temperature) separately.  

! Lower atmosphere loop
      if (lay <= laytrop(iplon)) then
         speccomb = colh2o(iplon,lay) + rat_h2och4(iplon,lay)*colch4(iplon,lay)
         specparm = colh2o(iplon,lay)/speccomb
         if (specparm .ge. oneminusd) specparm = oneminusd
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult,1.0 )

         speccomb1 = colh2o(iplon,lay) + rat_h2och4_1(iplon,lay)*colch4(iplon,lay)
         specparm1 = colh2o(iplon,lay)/speccomb1
         if (specparm1 .ge. oneminusd) specparm1 = oneminusd
         specmult1 = 8. *(specparm1)
         js1 = 1 + int(specmult1)
         fs1 = mod(specmult1,1.0 )

         speccomb_planck = colh2o(iplon,lay)+refrat_planck_a*colch4(iplon,lay)
         specparm_planck = colh2o(iplon,lay)/speccomb_planck
         if (specparm_planck .ge. oneminusd) specparm_planck=oneminusd
         specmult_planck = 8. *specparm_planck
         jpl= 1 + int(specmult_planck)
         fpl = mod(specmult_planck,1.0 )

         ind0 = ((jp(iplon,lay)-1)*5+(jt(iplon,lay)-1))*nspad(16) + js
         ind1 = (jp(iplon,lay)*5+(jt1(iplon,lay)-1))*nspad(16) + js1
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)

         if (specparm .lt. 0.125 ) then
            p = fs - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else if (specparm .gt. 0.875 ) then
            p = -fs 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac000 = fk0*fac00(iplon,lay)
            fac100 = fk1*fac00(iplon,lay)
            fac200 = fk2*fac00(iplon,lay)
            fac010 = fk0*fac10(iplon,lay)
            fac110 = fk1*fac10(iplon,lay)
            fac210 = fk2*fac10(iplon,lay)
         else
            fac000 = (1.  - fs) * fac00(iplon,lay)
            fac010 = (1.  - fs) * fac10(iplon,lay)
            fac100 = fs * fac00(iplon,lay)
            fac110 = fs * fac10(iplon,lay)
         endif

         if (specparm1 .lt. 0.125 ) then
            p = fs1 - 1
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else if (specparm1 .gt. 0.875 ) then
            p = -fs1 
            p4 = p**4
            fk0 = p4
            fk1 = 1 - p - 2.0 *p4
            fk2 = p + p4
            fac001 = fk0*fac01(iplon,lay)
            fac101 = fk1*fac01(iplon,lay)
            fac201 = fk2*fac01(iplon,lay)
            fac011 = fk0*fac11(iplon,lay)
            fac111 = fk1*fac11(iplon,lay)
            fac211 = fk2*fac11(iplon,lay)
         else
            fac001 = (1.  - fs1) * fac01(iplon,lay)
            fac011 = (1.  - fs1) * fac11(iplon,lay)
            fac101 = fs1 * fac01(iplon,lay)
            fac111 = fs1 * fac11(iplon,lay)
         endif

         do ig = 1, ng16
            tauself = selffac(iplon,lay)* (selfrefd(inds,ig) + selffrac(iplon,lay) * &
                 (selfrefd(inds+1,ig) - selfrefd(inds,ig)))
            taufor =  forfac(iplon,lay) * (forrefd(indf,ig) + forfrac(iplon,lay) * &
                 (forrefd(indf+1,ig) - forrefd(indf,ig))) 

            if (specparm .lt. 0.125 ) then
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac200 * absad(ind0+2,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig) + &
                    fac210 * absad(ind0+11,ig))
            else if (specparm .gt. 0.875 ) then
               tau_major = speccomb * &
                    (fac200 * absad(ind0-1,ig) + &
                    fac100 * absad(ind0,ig) + &
                    fac000 * absad(ind0+1,ig) + &
                    fac210 * absad(ind0+8,ig) + &
                    fac110 * absad(ind0+9,ig) + &
                    fac010 * absad(ind0+10,ig))
            else
               tau_major = speccomb * &
                    (fac000 * absad(ind0,ig) + &
                    fac100 * absad(ind0+1,ig) + &
                    fac010 * absad(ind0+9,ig) + &
                    fac110 * absad(ind0+10,ig))
            endif

            if (specparm1 .lt. 0.125 ) then
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac201 * absad(ind1+2,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig) + &
                    fac211 * absad(ind1+11,ig))
            else if (specparm1 .gt. 0.875 ) then
               tau_major1 = speccomb1 * &
                    (fac201 * absad(ind1-1,ig) + &
                    fac101 * absad(ind1,ig) + &
                    fac001 * absad(ind1+1,ig) + &
                    fac211 * absad(ind1+8,ig) + &
                    fac111 * absad(ind1+9,ig) + &
                    fac011 * absad(ind1+10,ig))
            else
               tau_major1 = speccomb1 * &
                    (fac001 * absad(ind1,ig) + &
                    fac101 * absad(ind1+1,ig) + &
                    fac011 * absad(ind1+9,ig) + &
                    fac111 * absad(ind1+10,ig))
            endif

            taug(iplon,lay,ngs15+ig) = tau_major + tau_major1 &
                 + tauself + taufor
            fracsd(iplon,lay,ngs15+ig) = fracrefad(ig,jpl) + fpl * &
                 (fracrefad(ig,jpl+1)-fracrefad(ig,jpl))
         enddo
      else
         ind0 = ((jp(iplon,lay)-13)*5+(jt(iplon,lay)-1))*nspbd(16) + 1
         ind1 = ((jp(iplon,lay)-12)*5+(jt1(iplon,lay)-1))*nspbd(16) + 1
         do ig = 1, ng16
            taug(iplon,lay,ngs15+ig) = colch4(iplon,lay) * &
                 (fac00(iplon,lay) * absbd(ind0,ig) + &
                 fac10(iplon,lay) * absbd(ind0+1,ig) + &
                 fac01(iplon,lay) * absbd(ind1,ig) + &
                 fac11(iplon,lay) * absbd(ind1+1,ig))
            fracsd(iplon,lay,ngs15+ig) = fracrefbd(ig)
         enddo
      endif

#ifdef _ACCEL
      endif
#else
      end do
      end do
#endif

      end subroutine taugb16g


      _gpuker subroutine addAerosols( ncol, nlayers, ngptlw, nbndlw, ngbd, taug &
#include "taug_cpu_args.h"
                                    )

      integer , intent(in), value :: ncol, nlayers, ngptlw, nbndlw
      integer , intent(in) :: ngbd(:)
        
#include "taug_cpu_defs.h"
        
      integer  :: iplon, lay, ig
      real  _gpudev :: taug(:,:,:)
     
#ifdef _ACCEL     
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      lay = (blockidx%y-1) * blockdim%y + threadidx%y
      ig = (blockidx%z-1) * blockdim%z + threadidx%z
      if (iplon<=ncol .and. lay<=nlayers .and. ig<=ngptlw) then
#else
      do iplon = 1, ncol
      do lay = 1, nlayers
      do ig = 1, ngptlw
#endif

        taug(iplon, lay, ig) = taug(iplon, lay, ig) + tauaa(iplon, lay, ngbd(ig))

#ifdef _ACCEL
      endif
#else
      end do
      end do
      end do
#endif

      end subroutine

!----------------------------------------------------------------------------

      subroutine taumolg(iplon, ncol, nlayers, ngbd, taug, fracsd & 1,1
#include "taug_cpu_args.h"
                        )
!----------------------------------------------------------------------------

! *******************************************************************************
! *                                                                             *
! *                  Optical depths developed for the                           *
! *                                                                             *
! *                RAPID RADIATIVE TRANSFER MODEL (RRTM)                        *
! *                                                                             *
! *                                                                             *
! *            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     *
! *                        131 HARTWELL AVENUE                                  *
! *                        LEXINGTON, MA 02421                                  *
! *                                                                             *
! *                                                                             *
! *                           ELI J. MLAWER                                     * 
! *                         JENNIFER DELAMERE                                   * 
! *                         STEVEN J. TAUBMAN                                   *
! *                         SHEPARD A. CLOUGH                                   *
! *                                                                             *
! *                                                                             *
! *                                                                             *
! *                                                                             *
! *                       email:  mlawer@aer.com                                *
! *                       email:  jdelamer@aer.com                              *
! *                                                                             *
! *        The authors wish to acknowledge the contributions of the             *
! *        following people:  Karen Cady-Pereira, Patrick D. Brown,             *  
! *        Michael J. Iacono, Ronald E. Farren, Luke Chen, Robert Bergstrom.    *
! *                                                                             *
! *******************************************************************************
! *                                                                             *
! *  Revision for g-point reduction: Michael J. Iacono, AER, Inc.               *
! *                                                                             *
! *******************************************************************************
! *     TAUMOL                                                                  *
! *                                                                             *
! *     This file contains the subroutines TAUGBn (where n goes from            *
! *     1 to 16).  TAUGBn calculates the optical depths and Planck fractions    *
! *     per g-value and layer for band n.                                       *
! *                                                                             *
! *  Output:  optical depths (unitless)                                         *
! *           fractions needed to compute Planck functions at every layer       *
! *               and g-value                                                   *
! *                                                                             *
! *     COMMON /TAUGCOM/  TAUG(MXLAY,MG)                                        *
! *     COMMON /PLANKG/   fracsd(MXLAY,MG)                                       *
! *                                                                             *
! *  Input                                                                      *
! *                                                                             *
! *     COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)                  *
! *     COMMON /PRECISE/  oneminusd                                              *
! *     COMMON /PROFILE/  NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY),                    *
! *     &                 PZ(0:MXLAY),TZ(0:MXLAY)                               *
! *     COMMON /PROFDATA/ LAYTROP,                                              *
! *    &                  COLH2O(MXLAY),COLCO2(MXLAY),COLO3(MXLAY),             *
! *    &                  COLN2O(MXLAY),colco(MXLAY),COLCH4(MXLAY),             *
! *    &                  COLO2(MXLAY)
! *     COMMON /INTFAC/   fac00(iplon,MXLAY),fac01(iplon,MXLAY),                            *
! *    &                  FAC10(MXLAY),fac11(iplon,MXLAY)                             *
! *     COMMON /INTIND/   JP(MXLAY),JT(MXLAY),JT1(MXLAY)                        *
! *     COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY)       *
! *                                                                             *
! *     Description:                                                            *
! *     NG(IBAND) - number of g-values in band IBAND                            *
! *     NSPA(IBAND) - for the lower atmosphere, the number of reference         *
! *                   atmospheres that are stored for band IBAND per            *
! *                   pressure level and temperature.  Each of these            *
! *                   atmospheres has different relative amounts of the         *
! *                   key species for the band (i.e. different binary           *
! *                   species parameters).                                      *
! *     NSPB(IBAND) - same for upper atmosphere                                 *
! *     oneminusd - since problems are caused in some cases by interpolation     *
! *                parameters equal to or greater than 1, for these cases       *
! *                these parameters are set to this value, slightly < 1.        *
! *     PAVEL - layer pressures (mb)                                            *
! *     TAVEL - layer temperatures (degrees K)                                  *
! *     PZ - level pressures (mb)                                               *
! *     TZ - level temperatures (degrees K)                                     *
! *     LAYTROP - layer at which switch is made from one combination of         *
! *               key species to another                                        *
! *     COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water         *
! *               vapor,carbon dioxide, ozone, nitrous ozide, methane,          *
! *               respectively (molecules/cm**2)                                *
! *     FACij(LAY) - for layer LAY, these are factors that are needed to        *
! *                  compute the interpolation factors that multiply the        *
! *                  appropriate reference k-values.  A value of 0 (1) for      *
! *                  i,j indicates that the corresponding factor multiplies     *
! *                  reference k-value for the lower (higher) of the two        *
! *                  appropriate temperatures, and altitudes, respectively.     *
! *     JP - the index of the lower (in altitude) of the two appropriate        *
! *          reference pressure levels needed for interpolation                 *
! *     JT, JT1 - the indices of the lower of the two appropriate reference     *
! *               temperatures needed for interpolation (for pressure           *
! *               levels JP and JP+1, respectively)                             *
! *     SELFFAC - scale factor needed for water vapor self-continuum, equals    *
! *               (water vapor density)/(atmospheric density at 296K and        *
! *               1013 mb)                                                      *
! *     SELFFRAC - factor needed for temperature interpolation of reference     *
! *                water vapor self-continuum data                              *
! *     INDSELF - index of the lower of the two appropriate reference           *
! *               temperatures needed for the self-continuum interpolation      *
! *     FORFAC  - scale factor needed for water vapor foreign-continuum.        *
! *     FORFRAC - factor needed for temperature interpolation of reference      *
! *                water vapor foreign-continuum data                           *
! *     INDFOR  - index of the lower of the two appropriate reference           *
! *               temperatures needed for the foreign-continuum interpolation   *
! *                                                                             *
! *  Data input                                                                 *
! *     COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG),*
! *                 FORREF(4,MG), KA_M'MGAS', KB_M'MGAS'                        *
! *        (note:  n is the band number,'MGAS' is the species name of the minor *
! *         gas)                                                                *
! *                                                                             *
! *     Description:                                                            *
! *     KA - k-values for low reference atmospheres (key-species only)          *
! *          (units: cm**2/molecule)                                            *
! *     KB - k-values for high reference atmospheres (key-species only)         *
! *          (units: cm**2/molecule)                                            *
! *     KA_M'MGAS' - k-values for low reference atmosphere minor species        *
! *          (units: cm**2/molecule)                                            *
! *     KB_M'MGAS' - k-values for high reference atmosphere minor species       *
! *          (units: cm**2/molecule)                                            *
! *     SELFREF - k-values for water vapor self-continuum for reference         *
! *               atmospheres (used below LAYTROP)                              *
! *               (units: cm**2/molecule)                                       *
! *     FORREF  - k-values for water vapor foreign-continuum for reference      *
! *               atmospheres (used below/above LAYTROP)                        *
! *               (units: cm**2/molecule)                                       *
! *                                                                             *
! *     DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG)                     *
! *     EQUIVALENCE (KA,ABSA),(KB,ABSB)                                         *
! *                                                                             *
!*******************************************************************************

      use parrrtm_f, only : ng1

! ------- Declarations -------
#include "taug_cpu_defs.h"

! ----- Input -----
      integer , intent(in) :: iplon           ! the column number (move to calculated in kernel)
      integer , intent(in) :: ncol            ! the total number of columns
      integer , intent(in) :: nlayers         ! total number of layers
      integer  _gpudev, intent(in) :: ngbd(:)
      real , intent(in) _gpudev :: fracsd(:,:,:)
      real , intent(in) _gpudev :: taug(:,:,:)
   
      !real  :: taugcc(ncol, nlayers, 140)

! ----- Output -----
  
      integer :: i,j,err
      real :: t1, t2

#ifdef _ACCEL
      type(dim3) :: dimGrid, dimBlock
#endif
#ifdef _ACCEL
      !dimGrid = dim3( (ncol + 127) / 128, 1, 1)
          !dimBlock = dim3( 128,1,1)

      dimGrid = dim3( (ncol + 63) / 64, ((nlayers+1)/2), 1)
      dimBlock = dim3( 64, 2, 1)
      
#else
!jm this can be made constant if the arrays are padded out, otherwise
!jm will generate a seg fault computing garbage data on unused ends of vectors
!jm zap #  define ncol CHNK
#endif   

! Calculate gaseous optical depth and planck fractions for each spectral band.

! (dmb 2012) Here we configure the grid and thread blocks.  These subroutines are
! only parallelized across the column dimension so the blocks are one dimensional.
      call taugb1g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb2g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )
      
      call taugb3g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb4g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )
      
      call taugb5g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb6g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb7g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb8g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb9g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb10g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb11g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )
 
      call taugb12g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb13g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb14g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb15g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

      call taugb16g _gpuchv (ncol, nlayers, taug, fracsd  &
#include "taug_cpu_args.h"
                           )

#ifdef _ACCEL
      dimGrid = dim3( (ncol+ 255) / 256, nlayers, ngptlw )
      dimBlock = dim3( 256, 1, 1)
#endif

! (dmb 2012) This code used to be in the main rrtmg_lw_rad source file
! We add the aerosol optical depths to the gas optical depths
      call addAerosols _gpuchv (ncol, nlayers, ngptlw, nbndlw, ngbd, taug &
#include "taug_cpu_args.h"
                               )

      end subroutine taumolg

#ifndef _ACCEL
! undefines for taug functions
# undef absad
# undef absbd
# undef absbod
# undef ccl4d
# undef ccl4od
# undef cfc11adjd
# undef cfc11adjod
# undef cfc12d
# undef cfc12od
# undef cfc22adjd
# undef cfc22adjod
# undef forrefd
# undef forrefod
# undef fracrefad
# undef fracrefaod
# undef fracrefbd
# undef fracrefbod
# undef kad
# undef ka_mcod
# undef ka_mco2d
# undef ka_mn2d
# undef ka_mn2od
# undef ka_mo2d
# undef ka_mo3d
# undef kaod
# undef kao_mcod
# undef kao_mco2d
# undef kao_mn2d
# undef kao_mn2od
# undef kao_mo3d
# undef kbd
# undef kb_mco2d
# undef kb_mn2d
# undef kb_mn2od
# undef kb_mo2d
# undef kb_mo3d
# undef kbod
# undef kbo_mco2d
# undef kbo_mn2od
# undef kbo_mo3d
# undef selfrefd
# undef selfrefod
#endif


!#ifndef _ACCEL
#  undef ncol
!#endif

! (dmb 2012) Allocate all of the needed memory for the taumol subroutines

      subroutine allocateGPUTaumol(ncol, nlayers, npart) 1,1

      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers
      integer , intent(in) :: npart
      integer :: i
#ifdef _ACCEL
      sreg( wx1 , ncol, nlayers )
      sreg( wx2 , ncol, nlayers )
      sreg( wx3 , ncol, nlayers )
      sreg( wx4 , ncol, nlayers )

      sreg( jp , ncol, nlayers )
      sreg( jt , ncol, nlayers )
      sreg( jt1 , ncol, nlayers )
      sreg( colh2o , ncol, nlayers )
      sreg( colco2 , ncol, nlayers )
      sreg( colo3 , ncol, nlayers )
      sreg( coln2o , ncol, nlayers )
      sreg( colco , ncol, nlayers )
      sreg( colch4 , ncol, nlayers )
      sreg( colo2 , ncol, nlayers )
      sreg( colbrd , ncol, nlayers )
      sreg( indself , ncol, nlayers )
      sreg( indfor , ncol, nlayers )
      sreg( selffac , ncol, nlayers )
      sreg( selffrac , ncol, nlayers )
      sreg( forfac , ncol, nlayers )
      sreg( forfrac , ncol, nlayers )
      sreg( indminor , ncol, nlayers )
      sreg( minorfrac , ncol, nlayers )
      sreg( scaleminor , ncol, nlayers )
      sreg( scaleminorn2 , ncol, nlayers )
        
      sreg( fac00 , ncol, nlayers )
      sreg( fac10 , ncol, nlayers )
      sreg( fac01 , ncol, nlayers )
      sreg( fac11 , ncol, nlayers )
      sreg( rat_h2oco2 , ncol, nlayers )
      sreg( rat_h2oco2_1 , ncol, nlayers )
      sreg( rat_h2oo3 , ncol, nlayers )
      sreg( rat_h2oo3_1 , ncol, nlayers )
      sreg( rat_h2on2o , ncol, nlayers )
      sreg( rat_h2on2o_1 , ncol, nlayers )
      sreg( rat_h2och4 , ncol, nlayers )
      sreg( rat_h2och4_1 , ncol, nlayers )
      sreg( rat_n2oco2 , ncol, nlayers )
      sreg( rat_n2oco2_1 , ncol, nlayers )
      sreg( rat_o3co2 , ncol, nlayers )
      sreg( rat_o3co2_1 , ncol, nlayers )

      call dflush()

      allocate( pavel( ncol, nlayers ))
      dreg( wx1 , ncol, nlayers )
      dreg( wx2 , ncol, nlayers )
      dreg( wx3 , ncol, nlayers )
      dreg( wx4 , ncol, nlayers )

      allocate( coldry( ncol, nlayers ))
        
      dreg( jp , ncol, nlayers )
      dreg( jt , ncol, nlayers )
      dreg( jt1 , ncol, nlayers )
      dreg( colh2o , ncol, nlayers )
      dreg( colco2 , ncol, nlayers )
      dreg( colo3 , ncol, nlayers )
      dreg( coln2o , ncol, nlayers )
      dreg( colco , ncol, nlayers )
      dreg( colch4 , ncol, nlayers )
      dreg( colo2 , ncol, nlayers )
      dreg( colbrd , ncol, nlayers )
      dreg( indself , ncol, nlayers )
      dreg( indfor , ncol, nlayers )
      dreg( selffac , ncol, nlayers )
      dreg( selffrac , ncol, nlayers )
      dreg( forfac , ncol, nlayers )
      dreg( forfrac , ncol, nlayers )
      dreg( indminor , ncol, nlayers )
      dreg( minorfrac , ncol, nlayers )
      dreg( scaleminor , ncol, nlayers )
      dreg( scaleminorn2 , ncol, nlayers )

      dreg( fac00 , ncol, nlayers )
      dreg( fac10 , ncol, nlayers )
      dreg( fac01 , ncol, nlayers )
      dreg( fac11 , ncol, nlayers )
      dreg( rat_h2oco2 , ncol, nlayers )
      dreg( rat_h2oco2_1 , ncol, nlayers )
      dreg( rat_h2oo3 , ncol, nlayers )
      dreg( rat_h2oo3_1 , ncol, nlayers )
      dreg( rat_h2on2o , ncol, nlayers )
      dreg( rat_h2on2o_1 , ncol, nlayers )
      dreg( rat_h2och4 , ncol, nlayers )
      dreg( rat_h2och4_1 , ncol, nlayers )
      dreg( rat_n2oco2 , ncol, nlayers )
      dreg( rat_n2oco2_1 , ncol, nlayers )
      dreg( rat_o3co2 , ncol, nlayers )
      dreg( rat_o3co2_1 , ncol, nlayers )

      allocate( laytrop( ncol ))
      allocate( tauaa( ncol, nlayers, nbndlw ))
      allocate( nspad( nbndlw ))
      allocate( nspbd( nbndlw ))

#endif
        
      end subroutine

! (dmb 2012) Perform the necessary cleanup of the GPU arrays

      subroutine deallocateGPUTaumol() 1,2

#ifdef _ACCEL
      call dbclean
      call dclean
      deallocate( pavel)
      
      deallocate( tauaa )
      deallocate( laytrop)
       
      deallocate( nspad)
      deallocate( nspbd)
      deallocate( coldry)
#endif

      end subroutine
       

      subroutine copyGPUTaumolMol( colstart, pncol, nlayers, colh2oc, colco2c, colo3c, coln2oc, colch4c, colo2c,& 1
                                   px1,px2,px3,px4, npart)
        
      integer, value, intent(in) :: colstart, pncol, nlayers, npart
      real , intent(in) :: colh2oc(:,:), colco2c(:,:), colo3c(:,:), coln2oc(:,:), &
                                     colch4c(:,:), colo2c(:,:), px1(:,:), px2(:,:), px3(:,:), px4(:,:)

#ifdef _ACCEL
      if (npart > 1) then
        colh2o(1:pncol, :) = colh2oc( colstart:(colstart+pncol-1), 1:nlayers)
        colco2(1:pncol, :) = colco2c( colstart:(colstart+pncol-1), 1:nlayers)
        colo3(1:pncol, :) = colo3c( colstart:(colstart+pncol-1), 1:nlayers)
        coln2o(1:pncol, :) = coln2oc( colstart:(colstart+pncol-1), 1:nlayers)
      
        colch4(1:pncol, :) = colch4c( colstart:(colstart+pncol-1), 1:nlayers)
        colo2(1:pncol, :) = colo2c( colstart:(colstart+pncol-1), 1:nlayers)
        wx1(1:pncol, :) = px1(colstart:(colstart+pncol-1), 1:nlayers)
        wx2(1:pncol, :) = px2(colstart:(colstart+pncol-1), 1:nlayers)
        wx3(1:pncol, :) = px3(colstart:(colstart+pncol-1), 1:nlayers)
        wx4(1:pncol, :) = px4(colstart:(colstart+pncol-1), 1:nlayers)
      else
        colh2o = colh2oc
        colco2 = colco2c
        colo3 = colo3c
        coln2o = coln2oc
        colch4 = colch4c
        colo2 = colo2c
        wx1 = px1
        wx2 = px2
        wx3 = px3
        wx4 = px4

      endif
      colco = 0
#endif
      end subroutine

! (dmb 2012) Copy the needed data from the CPU to the GPU.  I had to separate this
! out into 16 separate functions to correspond with the 16 taumol subroutines.

      subroutine copyGPUTaumol(pavelc, wxc, coldryc, tauap, pncol, colstart, nlay, npart) 1,49

      use rrlw_kg01_f, only : copyToGPU1, reg1
      use rrlw_kg02_f, only : copyToGPU2, reg2
      use rrlw_kg03_f, only : copyToGPU3, reg3
      use rrlw_kg04_f, only : copyToGPU4, reg4
      use rrlw_kg05_f, only : copyToGPU5, reg5
      use rrlw_kg06_f, only : copyToGPU6, reg6
      use rrlw_kg07_f, only : copyToGPU7, reg7
      use rrlw_kg08_f, only : copyToGPU8, reg8
      use rrlw_kg09_f, only : copyToGPU9, reg9
      use rrlw_kg10_f, only : copyToGPU10, reg10
      use rrlw_kg11_f, only : copyToGPU11, reg11
      use rrlw_kg12_f, only : copyToGPU12, reg12
      use rrlw_kg13_f, only : copyToGPU13, reg13
      use rrlw_kg14_f, only : copyToGPU14, reg14
      use rrlw_kg15_f, only : copyToGPU15, reg15
      use rrlw_kg16_f, only : copyToGPU16, reg16
      use rrlw_ref_f, only  : copyToGPUref

      real , intent(in) :: pavelc(:,:)                ! layer pressures (mb) 
                                                      !    Dimensions: (ncol,nlayers)
      real  , intent(in) :: wxc(:,:,:)                ! cross-section amounts (mol/cm2)
                                                      !    Dimensions: (ncol,maxxsec,nlayers)
      real  , intent(in) :: coldryc(:,:)              ! column amount (dry air)
                                                      !    Dimensions: (ncol,nlayers)

      real , intent(in) :: tauap(:,:,:)
                                                      !    Dimensions: (ncol,nlayers,ngptlw)
      integer, intent(in)      :: pncol, colstart, nlay, npart
     
#ifdef _ACCEL
      call reg1
      call reg2
      call reg3
      call reg4
      call reg5
      call reg6
      call reg7
      call reg8
      call reg9
      call reg10
      call reg11
      call reg12
      call reg13
      call reg14
      call reg15
      call reg16
      
      dbflushreg()
      call CopyToGPU1
      call CopyToGPU2
      call CopyToGPU3
      call CopyToGPU4
      call CopyToGPU5
      call CopyToGPU6
      call CopyToGPU7
      call CopyToGPU8
      call CopyToGPU9
      call CopyToGPU10
      call CopyToGPU11
      call CopyToGPU12
      call CopyToGPU13
      call CopyToGPU14
      call CopyToGPU15
      call CopyToGPU16

      nspad= nspa
      nspbd= nspb
      pavel= pavelc
      coldry= coldryc
      
      oneminusd = oneminus

      dbflushcop()
     
      if (npart > 1) then
         tauaa(1:pncol, :, :)  = tauap(colstart:(colstart+pncol-1), :, :)
      else
         tauaa = tauap
      endif
#endif
      end subroutine 

      end module gpu_rrtmg_lw_taumol

! This is the gpu version of the setcoef routine.

      module gpu_rrtmg_lw_setcoef 1,6

      use gpu_rrtmg_lw_rtrnmc
     
      use parrrtm_f, only : nbndlw, mg, maxxsec, mxmol
      use rrlw_wvn_f, only: totplnk, totplk16, totplnkderiv, totplk16deriv
      use rrlw_vsn_f, only: hvrset, hnamset
      use rrlw_ref_f, only : chi_mlsd
     
      use gpu_rrtmg_lw_taumol
   
      implicit none

#ifdef _ACCEL
      real  _gpudev, allocatable :: taveld(:,:)          ! layer temperatures (K)
                                                         !    Dimensions: (ncol,nlayers)
      real  _gpudev, allocatable :: tzd(:,:)             ! level (interface) temperatures (K)
                                                         !    Dimensions: (ncol,0:nlayers)
      real  _gpudev, allocatable :: tboundd(:)           ! surface temperature (K)
                                                         !    Dimensions: (ncol)
      real  _gpudev, allocatable :: wbroadd(:,:)         ! broadening gas column density (mol/cm2)
                                                         !    Dimensions: (ncol,nlayers)

      real  _gpudev :: totplnkd(181,nbndlw)
      real  _gpudev :: totplk16d(181)

      real  _gpudev :: totplnkderivd(181,nbndlw)
      real  _gpudev :: totplk16derivd(181)
!$OMP THREADPRIVATE(taveld,tzd,tboundd,wbroadd,totplnkd,totplk16d,totplnkderivd,totplk16derivd)
#endif

      contains

! (dmb 2012) This subroutine allocates the needed GPU arrays

      subroutine allocateGPUSetCoef( ncol, nlayers ) 1

         integer, intent(in) :: ncol
         integer, intent(in) :: nlayers
#ifdef _ACCEL
         allocate( taveld( ncol, nlayers) )
         allocate( tzd( ncol, 0:nlayers) )
         allocate( tboundd( ncol ))
         allocate( wbroadd( ncol, nlayers) )
#endif
   
      end subroutine

! (dmb 2012) This subroutine deallocates the GPU arrays

      subroutine deallocateGPUSetCoef( ) 1

#ifdef _ACCEL
         deallocate( taveld )
         deallocate( tzd )
         deallocate( tboundd)
         deallocate( wbroadd)
#endif
      
      end subroutine

! (dmb 2012) Copy the needed reference data from the CPU to the GPU

      subroutine copyGPUSetCoef() 1

#ifdef _ACCEL
         totplnkd = totplnk
         totplk16d = totplk16
         totplnkderivd = totplnkderiv
         totplk16derivd = totplk16deriv
#endif

      end subroutine

!----------------------------------------------------------------------------

      _gpuker subroutine setcoefg(ncol, nlayers, istart                       &
# include "rrtmg_lw_cpu_args.h"
# include "taug_cpu_args.h"
#ifndef _ACCEL
   ,taveld,tzd,tboundd,wbroadd,totplnkd,totplk16d,totplnkderivd,totplk16derivd &
#endif
                                 )
!----------------------------------------------------------------------------
!
!  Purpose:  For a given atmosphere, calculate the indices and
!  fractions related to the pressure and temperature interpolations.
!  Also calculate the values of the integrated Planck functions 
!  for each band at the level and layer temperatures.

! ------- Declarations -------
#ifndef _ACCEL
# include "rrtmg_lw_cpu_defs.h"
# include "taug_cpu_defs.h"
      real  :: taveld(CHNK,nlayers+1)       ! layer temperatures (K)
                                            !    Dimensions: (ncol,nlayers)
      real  :: tzd(CHNK,0:nlayers+1)        ! level (interface) temperatures (K)
                                            !    Dimensions: (ncol,0:nlayers)
      real  :: tboundd(CHNK)                ! surface temperature (K)
                                            !    Dimensions: (ncol)
      real  :: wbroadd(CHNK,nlayers+1)      ! broadening gas column density (mol/cm2)
                                            !    Dimensions: (ncol,nlayers)

      real  :: totplnkd(181,nbndlw)
      real  :: totplk16d(181)

      real  :: totplnkderivd(181,nbndlw)
      real  :: totplk16derivd(181)
#endif

! ----- Input -----
      integer , value, intent(in) :: ncol
      integer , value, intent(in) :: nlayers         ! total number of layers
      integer , value, intent(in) :: istart          ! beginning band of calculation
!jm      integer , value, intent(in) :: idrv            ! Planck derivative option flag

! ----- Local -----
      integer  :: indbound, indlev0
      integer  :: lay, indlay, indlev, iband
      integer  :: jp1
      real  :: stpfac, tbndfrac, t0frac, tlayfrac, tlevfrac
      real  :: dbdtlev, dbdtlay
      real  :: plog, fp, ft, ft1, water, scalefac, factor, compfp
      integer  :: iplon
      real  :: wv, lcoldry

#ifdef _ACCEL
      iplon = (blockidx%x-1) * blockdim%x + threadidx%x
      if (iplon <= ncol) then
#else
      do iplon = 1, ncol
#endif

        stpfac = 296. /1013. 

        indbound = tboundd(iplon) - 159. 
        if (indbound .lt. 1) then
           indbound = 1
        elseif (indbound .gt. 180) then
           indbound = 180
        endif
        tbndfrac = tboundd(iplon) - 159.  - float(indbound)
        indlev0 = tzd(iplon, 0) - 159. 
        if (indlev0 .lt. 1) then
           indlev0 = 1
        elseif (indlev0 .gt. 180) then
           indlev0 = 180
        endif
        t0frac = tzd(iplon, 0) - 159.  - float(indlev0)
        laytrop(iplon) = 0

! Begin layer loop 
!  Calculate the integrated Planck functions for each band at the
!  surface, level, and layer temperatures.
        do lay = 1, nlayers
          indlay = taveld(iplon, lay) - 159. 
          lcoldry = coldry( iplon, lay) 
          wv = colh2o(iplon, lay) * lcoldry
          if (indlay .lt. 1) then
             indlay = 1
          elseif (indlay .gt. 180) then
             indlay = 180
          endif
          tlayfrac = taveld(iplon, lay) - 159.  - float(indlay)
          indlev = tzd(iplon, lay) - 159. 
          if (indlev .lt. 1) then
             indlev = 1
          elseif (indlev .gt. 180) then
             indlev = 180
          endif
          tlevfrac = tzd(iplon, lay) - 159.  - float(indlev)

! Begin spectral band loop 
          do iband = 1, 15
            if (lay.eq.1) then
               dbdtlev = totplnkd(indbound+1,iband) - totplnkd(indbound,iband)
               plankbndd(iplon, iband) = semissd(iplon, iband) * &
                   (totplnkd(indbound,iband) + tbndfrac * dbdtlev)
               dbdtlev = totplnkd(indlev0+1,iband)-totplnkd(indlev0,iband)
               planklevd(iplon, 0,iband) = totplnkd(indlev0,iband) + t0frac * dbdtlev
               if (idrvd .eq. 1) then 
                  dbdtlev = totplnkderivd(indbound+1,iband) - totplnkderivd(indbound,iband)
                  dplankbnd_dtd(iplon, iband) = semissd(iplon, iband) * &
                        (totplnkderivd(indbound,iband) + tbndfrac * dbdtlev)
               endif
            endif
            dbdtlev = totplnkd(indlev+1,iband) - totplnkd(indlev,iband)
            dbdtlay = totplnkd(indlay+1,iband) - totplnkd(indlay,iband)
            planklayd(iplon, lay,iband) = totplnkd(indlay,iband) + tlayfrac * dbdtlay

            planklevd(iplon, lay,iband) = totplnkd(indlev,iband) + tlevfrac * dbdtlev
          enddo

!  For band 16, if radiative transfer will be performed on just
!  this band, use integrated Planck values up to 3250 cm-1.  
!  If radiative transfer will be performed across all 16 bands,
!  then include in the integrated Planck values for this band
!  contributions from 2600 cm-1 to infinity.
          iband = 16
          if (istart .eq. 16) then
             if (lay.eq.1) then
                dbdtlev = totplk16d( indbound+1) - totplk16d( indbound)
                plankbndd(iplon, iband) = semissd(iplon, iband) * &
                     (totplk16d( indbound) + tbndfrac * dbdtlev)
                if (idrvd .eq. 1) then
                   dbdtlev = totplk16derivd( indbound+1) - totplk16derivd( indbound)
                   dplankbnd_dtd(iplon, iband) = semissd(iplon, iband) * &
                        (totplk16derivd(indbound) + tbndfrac * dbdtlev)
                endif
                dbdtlev = totplnkd(indlev0+1,iband)-totplnkd(indlev0,iband)
                planklevd(iplon, 0,iband) = totplk16d( indlev0) + &
                     t0frac * dbdtlev
             endif
             dbdtlev = totplk16d( indlev+1) - totplk16d( indlev)
             dbdtlay = totplk16d( indlay+1) - totplk16d( indlay)
             planklayd(iplon, lay,iband) = totplk16d( indlay) + tlayfrac * dbdtlay
             planklevd(iplon, lay,iband) = totplk16d( indlev) + tlevfrac * dbdtlev
          else
             if (lay.eq.1) then
                dbdtlev = totplnkd(indbound+1,iband) - totplnkd(indbound,iband)
                plankbndd(iplon, iband) = semissd(iplon, iband) * &
                     (totplnkd(indbound,iband) + tbndfrac * dbdtlev)
                if (idrvd .eq. 1) then 
                   dbdtlev = totplnkderivd( indbound+1,iband) - totplnkderivd( indbound,iband)
                   dplankbnd_dtd(iplon, iband) = semissd(iplon, iband) * &
                        (totplnkderivd( indbound,iband) + tbndfrac * dbdtlev)
                endif
                dbdtlev = totplnkd(indlev0+1,iband)-totplnkd(indlev0,iband)
                planklevd(iplon, 0,iband) = totplnkd(indlev0,iband) + t0frac * dbdtlev
             endif
             dbdtlev = totplnkd(indlev+1,iband) - totplnkd(indlev,iband)
             dbdtlay = totplnkd(indlay+1,iband) - totplnkd(indlay,iband)
             planklayd(iplon, lay,iband) = totplnkd(indlay,iband) + tlayfrac * dbdtlay
             planklevd(iplon, lay,iband) = totplnkd(indlev,iband) + tlevfrac * dbdtlev
          endif


!  Find the two reference pressures on either side of the
!  layer pressure.  Store them in JP and JP1.  Store in FP the
!  fraction of the difference (in ln(pressure)) between these
!  two values that the layer pressure lies.
!         plog = alog(pavel(lay))
          plog = alog(pavel(iplon, lay))
          jp(iplon, lay) = int(36.  - 5*(plog+0.04 ))
          if (jp(iplon, lay) .lt. 1) then
             jp(iplon, lay) = 1
          elseif (jp(iplon, lay) .gt. 58) then
             jp(iplon, lay) = 58
          endif
          jp1 = jp(iplon, lay) + 1
          fp = 5.  *(preflogd(jp(iplon, lay)) - plog)

!  Determine, for each reference pressure (JP and JP1), which
!  reference temperature (these are different for each  
!  reference pressure) is nearest the layer temperature but does
!  not exceed it.  Store these indices in JT and JT1, resp.
!  Store in FT (resp. FT1) the fraction of the way between JT
!  (JT1) and the next highest reference temperature that the 
!  layer temperature falls.
          jt(iplon, lay) = int(3.  + (taveld(iplon, lay)-trefd(jp(iplon, lay)))/15. )
          if (jt(iplon, lay) .lt. 1) then
             jt(iplon, lay) = 1
          elseif (jt(iplon, lay) .gt. 4) then
             jt(iplon, lay) = 4
          endif
          ft = ((taveld(iplon, lay)-trefd(jp(iplon, lay)))/15. ) - float(jt(iplon, lay)-3)
          jt1(iplon, lay) = int(3.  + (taveld(iplon, lay)-trefd( jp1))/15. )
          if (jt1(iplon, lay) .lt. 1) then
             jt1(iplon, lay) = 1
          elseif (jt1(iplon, lay) .gt. 4) then
             jt1(iplon, lay) = 4
          endif
          ft1 = ((taveld(iplon, lay)-trefd(jp1))/15. ) - float(jt1(iplon, lay)-3)
          water = wv/lcoldry
          scalefac = pavel(iplon, lay) * stpfac / taveld(iplon, lay)

!  If the pressure is less than ~100mb, perform a different
!  set of species interpolations.
          if (plog .le. 4.56 ) go to 5300
          laytrop(iplon) =  laytrop(iplon) + 1

          forfac(iplon, lay) = scalefac / (1.+water)
          factor = (332.0 -taveld(iplon, lay))/36.0 
          indfor(iplon, lay) = min(2, max(1, int(factor)))
          forfrac(iplon, lay) = factor - float(indfor(iplon, lay))

!  Set up factors needed to separately include the water vapor
!  self-continuum in the calculation of absorption coefficient.
          selffac(iplon, lay) = water * forfac(iplon, lay)
          factor = (taveld(iplon, lay)-188.0 )/7.2 
          indself(iplon, lay) = min(9, max(1, int(factor)-7))
          selffrac(iplon, lay) = factor - float(indself(iplon, lay) + 7)

!  Set up factors needed to separately include the minor gases
!  in the calculation of absorption coefficient
          scaleminor(iplon, lay) = pavel(iplon, lay)/taveld(iplon, lay)
          scaleminorn2(iplon, lay) = (pavel(iplon, lay)/taveld(iplon, lay)) &
              *(wbroadd(iplon, lay)/(lcoldry+wv))
          factor = (taveld(iplon, lay)-180.8 )/7.2 
          indminor(iplon, lay) = min(18, max(1, int(factor)))
          minorfrac(iplon, lay) = factor - float(indminor(iplon, lay))

!  Setup reference ratio to be used in calculation of binary
!  species parameter in lower atmosphere.
          rat_h2oco2(iplon, lay)=chi_mlsd( 1,jp(iplon, lay))/chi_mlsd( 2,jp(iplon, lay))
          rat_h2oco2_1(iplon, lay)=chi_mlsd( 1,jp(iplon, lay)+1)/chi_mlsd( 2,jp(iplon, lay)+1)

          rat_h2oo3(iplon, lay)=chi_mlsd( 1,jp(iplon, lay))/chi_mlsd( 3,jp(iplon, lay))
          rat_h2oo3_1(iplon, lay)=chi_mlsd( 1,jp(iplon, lay)+1)/chi_mlsd( 3,jp(iplon, lay)+1)

          rat_h2on2o(iplon, lay)=chi_mlsd( 1,jp(iplon, lay))/chi_mlsd( 4,jp(iplon, lay))
          rat_h2on2o_1(iplon, lay)=chi_mlsd( 1,jp(iplon, lay)+1)/chi_mlsd( 4,jp(iplon, lay)+1)

          rat_h2och4(iplon, lay)=chi_mlsd( 1,jp(iplon, lay))/chi_mlsd( 6,jp(iplon, lay))
          rat_h2och4_1(iplon, lay)=chi_mlsd( 1,jp(iplon, lay)+1)/chi_mlsd( 6,jp(iplon, lay)+1)

          rat_n2oco2(iplon, lay)=chi_mlsd( 4,jp(iplon, lay))/chi_mlsd( 2,jp(iplon, lay))
          rat_n2oco2_1(iplon, lay)=chi_mlsd( 4,jp(iplon, lay)+1)/chi_mlsd( 2,jp(iplon, lay)+1)

!  Calculate needed column amounts.
          colh2o(iplon, lay) = 1.e-20  * colh2o(iplon, lay) * lcoldry
          colco2(iplon, lay) = 1.e-20  *  colco2(iplon, lay) * lcoldry
          colo3(iplon, lay) = 1.e-20  * colo3(iplon, lay) * lcoldry
          coln2o(iplon, lay) = 1.e-20  * coln2o(iplon, lay) * lcoldry
          colco(iplon, lay) = 1.e-20  * colco(iplon, lay) * lcoldry
          colch4(iplon, lay) = 1.e-20  * colch4(iplon, lay) * lcoldry
          colo2(iplon, lay) = 1.e-20  * colo2(iplon, lay) * lcoldry
          if (colco2(iplon, lay) .eq. 0. ) colco2(iplon, lay) = 1.e-32  * lcoldry
          if (colo3(iplon, lay) .eq. 0. ) colo3(iplon, lay) = 1.e-32  * lcoldry
          if (coln2o(iplon, lay) .eq. 0. ) coln2o(iplon, lay) = 1.e-32  * lcoldry
          if (colco(iplon, lay) .eq. 0. ) colco(iplon, lay) = 1.e-32  * lcoldry
          if (colch4(iplon, lay) .eq. 0. ) colch4(iplon, lay) = 1.e-32  * lcoldry
          colbrd(iplon, lay) = 1.e-20  * wbroadd(iplon, lay)
          go to 5400

!  Above laytrop.
 5300     continue

          forfac(iplon, lay) = scalefac / (1.+water)
          factor = (taveld(iplon, lay)-188.0 )/36.0 
          indfor(iplon, lay) = 3
          forfrac(iplon, lay) = factor - 1.0 

!  Set up factors needed to separately include the water vapor
!  self-continuum in the calculation of absorption coefficient.
          selffac(iplon, lay) = water * forfac(iplon, lay)

!  Set up factors needed to separately include the minor gases
!  in the calculation of absorption coefficient
          scaleminor(iplon, lay) = pavel(iplon, lay)/taveld(iplon, lay)         
          scaleminorn2(iplon, lay) = (pavel(iplon, lay)/taveld(iplon, lay)) &
              * (wbroadd(iplon, lay)/(coldry(iplon, lay)+wv))
          factor = (taveld(iplon, lay)-180.8 )/7.2 
          indminor(iplon, lay) = min(18, max(1, int(factor)))
          minorfrac(iplon, lay) = factor - float(indminor(iplon, lay))

!  Setup reference ratio to be used in calculation of binary
!  species parameter in upper atmosphere.
          rat_h2oco2(iplon, lay)=chi_mlsd( 1,jp(iplon, lay))/chi_mlsd( 2,jp(iplon, lay))
          rat_h2oco2_1(iplon, lay)=chi_mlsd( 1,jp(iplon, lay)+1)/chi_mlsd( 2,jp(iplon, lay)+1) 

          rat_o3co2(iplon, lay)=chi_mlsd( 3,jp(iplon, lay))/chi_mlsd( 2,jp(iplon, lay))
          rat_o3co2_1(iplon, lay)=chi_mlsd( 3,jp(iplon, lay)+1)/chi_mlsd( 2,jp(iplon, lay)+1)         

!  Calculate needed column amounts.
          colh2o(iplon, lay) = 1.e-20  * colh2o(iplon, lay) * lcoldry
          colco2(iplon, lay) = 1.e-20  *  colco2(iplon, lay) * lcoldry
          colo3(iplon, lay) = 1.e-20  * colo3(iplon, lay) * lcoldry
          coln2o(iplon, lay) = 1.e-20  * coln2o(iplon, lay) * lcoldry
          colco(iplon, lay) = 1.e-20  * colco(iplon, lay) * lcoldry
          colch4(iplon, lay) = 1.e-20  * colch4(iplon, lay) * lcoldry
          colo2(iplon, lay) = 1.e-20  * colo2(iplon, lay) * lcoldry
          if (colco2(iplon, lay) .eq. 0. ) colco2(iplon, lay) = 1.e-32  * lcoldry
          if (colo3(iplon, lay) .eq. 0. ) colo3(iplon, lay) = 1.e-32  * lcoldry
          if (coln2o(iplon, lay) .eq. 0. ) coln2o(iplon, lay) = 1.e-32  * lcoldry
          if (colco(iplon, lay)  .eq. 0. ) colco(iplon, lay) = 1.e-32  * lcoldry
          if (colch4(iplon, lay) .eq. 0. ) colch4(iplon, lay) = 1.e-32  * lcoldry
          colbrd(iplon, lay) = 1.e-20  * wbroadd(iplon, lay)
 5400     continue

!  We have now isolated the layer ln pressure and temperature,
!  between two reference pressures and two reference temperatures 
!  (for each reference pressure).  We multiply the pressure 
!  fraction FP with the appropriate temperature fractions to get 
!  the factors that will be needed for the interpolation that yields
!  the optical depths (performed in routines TAUGBn for band n).`

          compfp = 1. - fp
          fac10(iplon, lay) = compfp * ft
          fac00(iplon, lay) = compfp * (1.  - ft)
          fac11(iplon, lay) = fp * ft1
          fac01(iplon, lay) = fp * (1.  - ft1)

!  Rescale selffac and forfac for use in taumol
          selffac(iplon, lay) = colh2o(iplon, lay)*selffac(iplon, lay)
          forfac(iplon, lay) = colh2o(iplon, lay)*forfac(iplon, lay)
! End layer loop
        enddo

#ifdef _ACCEL
      endif
#else
      end do
#endif
      end subroutine setcoefg

      end module gpu_rrtmg_lw_setcoef


      module rrtmg_lw_setcoef_f 1,3

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! ------- Modules -------

!     use parkind, only : im => kind , rb => kind 
      use parrrtm_f, only : nbndlw, mg, maxxsec, mxmol
      use rrlw_wvn_f, only: totplnk, totplk16, totplnkderiv, totplk16deriv
      use rrlw_ref_f

      implicit none

      contains

!***************************************************************************

      subroutine lwatmref 2
!***************************************************************************

      save
 
! These pressures are chosen such that the ln of the first pressure
! has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and
! each subsequent ln(pressure) differs from the previous one by 0.2.

      pref(:) = (/ &
          1.05363e+03 ,8.62642e+02 ,7.06272e+02 ,5.78246e+02 ,4.73428e+02 , &
          3.87610e+02 ,3.17348e+02 ,2.59823e+02 ,2.12725e+02 ,1.74164e+02 , &
          1.42594e+02 ,1.16746e+02 ,9.55835e+01 ,7.82571e+01 ,6.40715e+01 , &
          5.24573e+01 ,4.29484e+01 ,3.51632e+01 ,2.87892e+01 ,2.35706e+01 , &
          1.92980e+01 ,1.57998e+01 ,1.29358e+01 ,1.05910e+01 ,8.67114e+00 , &
          7.09933e+00 ,5.81244e+00 ,4.75882e+00 ,3.89619e+00 ,3.18993e+00 , &
          2.61170e+00 ,2.13828e+00 ,1.75067e+00 ,1.43333e+00 ,1.17351e+00 , &
          9.60789e-01 ,7.86628e-01 ,6.44036e-01 ,5.27292e-01 ,4.31710e-01 , &
          3.53455e-01 ,2.89384e-01 ,2.36928e-01 ,1.93980e-01 ,1.58817e-01 , &
          1.30029e-01 ,1.06458e-01 ,8.71608e-02 ,7.13612e-02 ,5.84256e-02 , &
          4.78349e-02 ,3.91639e-02 ,3.20647e-02 ,2.62523e-02 ,2.14936e-02 , &
          1.75975e-02 ,1.44076e-02 ,1.17959e-02 ,9.65769e-03 /)

      preflog(:) = (/ &
           6.9600e+00 , 6.7600e+00 , 6.5600e+00 , 6.3600e+00 , 6.1600e+00 , &
           5.9600e+00 , 5.7600e+00 , 5.5600e+00 , 5.3600e+00 , 5.1600e+00 , &
           4.9600e+00 , 4.7600e+00 , 4.5600e+00 , 4.3600e+00 , 4.1600e+00 , &
           3.9600e+00 , 3.7600e+00 , 3.5600e+00 , 3.3600e+00 , 3.1600e+00 , &
           2.9600e+00 , 2.7600e+00 , 2.5600e+00 , 2.3600e+00 , 2.1600e+00 , &
           1.9600e+00 , 1.7600e+00 , 1.5600e+00 , 1.3600e+00 , 1.1600e+00 , &
           9.6000e-01 , 7.6000e-01 , 5.6000e-01 , 3.6000e-01 , 1.6000e-01 , &
          -4.0000e-02 ,-2.4000e-01 ,-4.4000e-01 ,-6.4000e-01 ,-8.4000e-01 , &
          -1.0400e+00 ,-1.2400e+00 ,-1.4400e+00 ,-1.6400e+00 ,-1.8400e+00 , &
          -2.0400e+00 ,-2.2400e+00 ,-2.4400e+00 ,-2.6400e+00 ,-2.8400e+00 , &
          -3.0400e+00 ,-3.2400e+00 ,-3.4400e+00 ,-3.6400e+00 ,-3.8400e+00 , &
          -4.0400e+00 ,-4.2400e+00 ,-4.4400e+00 ,-4.6400e+00 /)

! These are the temperatures associated with the respective 
! pressures for the mls standard atmosphere. 

      tref(:) = (/ &
           2.9420e+02 , 2.8799e+02 , 2.7894e+02 , 2.6925e+02 , 2.5983e+02 , &
           2.5017e+02 , 2.4077e+02 , 2.3179e+02 , 2.2306e+02 , 2.1578e+02 , &
           2.1570e+02 , 2.1570e+02 , 2.1570e+02 , 2.1706e+02 , 2.1858e+02 , &
           2.2018e+02 , 2.2174e+02 , 2.2328e+02 , 2.2479e+02 , 2.2655e+02 , &
           2.2834e+02 , 2.3113e+02 , 2.3401e+02 , 2.3703e+02 , 2.4022e+02 , &
           2.4371e+02 , 2.4726e+02 , 2.5085e+02 , 2.5457e+02 , 2.5832e+02 , &
           2.6216e+02 , 2.6606e+02 , 2.6999e+02 , 2.7340e+02 , 2.7536e+02 , &
           2.7568e+02 , 2.7372e+02 , 2.7163e+02 , 2.6955e+02 , 2.6593e+02 , &
           2.6211e+02 , 2.5828e+02 , 2.5360e+02 , 2.4854e+02 , 2.4348e+02 , &
           2.3809e+02 , 2.3206e+02 , 2.2603e+02 , 2.2000e+02 , 2.1435e+02 , &
           2.0887e+02 , 2.0340e+02 , 1.9792e+02 , 1.9290e+02 , 1.8809e+02 , &
           1.8329e+02 , 1.7849e+02 , 1.7394e+02 , 1.7212e+02 /)

       chi_mls(1,1:12) = (/ &
        1.8760e-02 , 1.2223e-02 , 5.8909e-03 , 2.7675e-03 , 1.4065e-03 , &
        7.5970e-04 , 3.8876e-04 , 1.6542e-04 , 3.7190e-05 , 7.4765e-06 , &
        4.3082e-06 , 3.3319e-06 /)
       chi_mls(1,13:59) = (/ &
        3.2039e-06 ,  3.1619e-06 ,  3.2524e-06 ,  3.4226e-06 ,  3.6288e-06 , &
        3.9148e-06 ,  4.1488e-06 ,  4.3081e-06 ,  4.4420e-06 ,  4.5778e-06 , &
        4.7087e-06 ,  4.7943e-06 ,  4.8697e-06 ,  4.9260e-06 ,  4.9669e-06 , &
        4.9963e-06 ,  5.0527e-06 ,  5.1266e-06 ,  5.2503e-06 ,  5.3571e-06 , &
        5.4509e-06 ,  5.4830e-06 ,  5.5000e-06 ,  5.5000e-06 ,  5.4536e-06 , &
        5.4047e-06 ,  5.3558e-06 ,  5.2533e-06 ,  5.1436e-06 ,  5.0340e-06 , &
        4.8766e-06 ,  4.6979e-06 ,  4.5191e-06 ,  4.3360e-06 ,  4.1442e-06 , &
        3.9523e-06 ,  3.7605e-06 ,  3.5722e-06 ,  3.3855e-06 ,  3.1988e-06 , &
        3.0121e-06 ,  2.8262e-06 ,  2.6407e-06 ,  2.4552e-06 ,  2.2696e-06 , &
        4.3360e-06 ,  4.1442e-06 /)
       chi_mls(2,1:12) = (/ &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 /)
       chi_mls(2,13:59) = (/ &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 ,  3.5500e-04 , &
        3.5500e-04 ,  3.5471e-04 ,  3.5427e-04 ,  3.5384e-04 ,  3.5340e-04 , &
        3.5500e-04 ,  3.5500e-04 /)
       chi_mls(3,1:12) = (/ &
        3.0170e-08 ,  3.4725e-08 ,  4.2477e-08 ,  5.2759e-08 ,  6.6944e-08 , &
        8.7130e-08 ,  1.1391e-07 ,  1.5677e-07 ,  2.1788e-07 ,  3.2443e-07 , &
        4.6594e-07 ,  5.6806e-07 /)
       chi_mls(3,13:59) = (/ &
        6.9607e-07 ,  1.1186e-06 ,  1.7618e-06 ,  2.3269e-06 ,  2.9577e-06 , &
        3.6593e-06 ,  4.5950e-06 ,  5.3189e-06 ,  5.9618e-06 ,  6.5113e-06 , &
        7.0635e-06 ,  7.6917e-06 ,  8.2577e-06 ,  8.7082e-06 ,  8.8325e-06 , &
        8.7149e-06 ,  8.0943e-06 ,  7.3307e-06 ,  6.3101e-06 ,  5.3672e-06 , &
        4.4829e-06 ,  3.8391e-06 ,  3.2827e-06 ,  2.8235e-06 ,  2.4906e-06 , &
        2.1645e-06 ,  1.8385e-06 ,  1.6618e-06 ,  1.5052e-06 ,  1.3485e-06 , &
        1.1972e-06 ,  1.0482e-06 ,  8.9926e-07 ,  7.6343e-07 ,  6.5381e-07 , &
        5.4419e-07 ,  4.3456e-07 ,  3.6421e-07 ,  3.1194e-07 ,  2.5967e-07 , &
        2.0740e-07 ,  1.9146e-07 ,  1.9364e-07 ,  1.9582e-07 ,  1.9800e-07 , &
        7.6343e-07 ,  6.5381e-07 /)
       chi_mls(4,1:12) = (/ &
        3.2000e-07 ,  3.2000e-07 ,  3.2000e-07 ,  3.2000e-07 ,  3.2000e-07 , &
        3.1965e-07 ,  3.1532e-07 ,  3.0383e-07 ,  2.9422e-07 ,  2.8495e-07 , &
        2.7671e-07 ,  2.6471e-07 /)
       chi_mls(4,13:59) = (/ &
        2.4285e-07 ,  2.0955e-07 ,  1.7195e-07 ,  1.3749e-07 ,  1.1332e-07 , &
        1.0035e-07 ,  9.1281e-08 ,  8.5463e-08 ,  8.0363e-08 ,  7.3372e-08 , &
        6.5975e-08 ,  5.6039e-08 ,  4.7090e-08 ,  3.9977e-08 ,  3.2979e-08 , &
        2.6064e-08 ,  2.1066e-08 ,  1.6592e-08 ,  1.3017e-08 ,  1.0090e-08 , &
        7.6249e-09 ,  6.1159e-09 ,  4.6672e-09 ,  3.2857e-09 ,  2.8484e-09 , &
        2.4620e-09 ,  2.0756e-09 ,  1.8551e-09 ,  1.6568e-09 ,  1.4584e-09 , &
        1.3195e-09 ,  1.2072e-09 ,  1.0948e-09 ,  9.9780e-10 ,  9.3126e-10 , &
        8.6472e-10 ,  7.9818e-10 ,  7.5138e-10 ,  7.1367e-10 ,  6.7596e-10 , &
        6.3825e-10 ,  6.0981e-10 ,  5.8600e-10 ,  5.6218e-10 ,  5.3837e-10 , &
        9.9780e-10 ,  9.3126e-10 /)
       chi_mls(5,1:12) = (/ &
        1.5000e-07 ,  1.4306e-07 ,  1.3474e-07 ,  1.3061e-07 ,  1.2793e-07 , &
        1.2038e-07 ,  1.0798e-07 ,  9.4238e-08 ,  7.9488e-08 ,  6.1386e-08 , &
        4.5563e-08 ,  3.3475e-08 /)
       chi_mls(5,13:59) = (/ &
        2.5118e-08 ,  1.8671e-08 ,  1.4349e-08 ,  1.2501e-08 ,  1.2407e-08 , &
        1.3472e-08 ,  1.4900e-08 ,  1.6079e-08 ,  1.7156e-08 ,  1.8616e-08 , &
        2.0106e-08 ,  2.1654e-08 ,  2.3096e-08 ,  2.4340e-08 ,  2.5643e-08 , &
        2.6990e-08 ,  2.8456e-08 ,  2.9854e-08 ,  3.0943e-08 ,  3.2023e-08 , &
        3.3101e-08 ,  3.4260e-08 ,  3.5360e-08 ,  3.6397e-08 ,  3.7310e-08 , &
        3.8217e-08 ,  3.9123e-08 ,  4.1303e-08 ,  4.3652e-08 ,  4.6002e-08 , &
        5.0289e-08 ,  5.5446e-08 ,  6.0603e-08 ,  6.8946e-08 ,  8.3652e-08 , &
        9.8357e-08 ,  1.1306e-07 ,  1.4766e-07 ,  1.9142e-07 ,  2.3518e-07 , &
        2.7894e-07 ,  3.5001e-07 ,  4.3469e-07 ,  5.1938e-07 ,  6.0407e-07 , &
        6.8946e-08 ,  8.3652e-08 /)
       chi_mls(6,1:12) = (/ &
        1.7000e-06 ,  1.7000e-06 ,  1.6999e-06 ,  1.6904e-06 ,  1.6671e-06 , &
        1.6351e-06 ,  1.6098e-06 ,  1.5590e-06 ,  1.5120e-06 ,  1.4741e-06 , &
        1.4385e-06 ,  1.4002e-06 /)
       chi_mls(6,13:59) = (/ &
        1.3573e-06 ,  1.3130e-06 ,  1.2512e-06 ,  1.1668e-06 ,  1.0553e-06 , &
        9.3281e-07 ,  8.1217e-07 ,  7.5239e-07 ,  7.0728e-07 ,  6.6722e-07 , &
        6.2733e-07 ,  5.8604e-07 ,  5.4769e-07 ,  5.1480e-07 ,  4.8206e-07 , &
        4.4943e-07 ,  4.1702e-07 ,  3.8460e-07 ,  3.5200e-07 ,  3.1926e-07 , &
        2.8646e-07 ,  2.5498e-07 ,  2.2474e-07 ,  1.9588e-07 ,  1.8295e-07 , &
        1.7089e-07 ,  1.5882e-07 ,  1.5536e-07 ,  1.5304e-07 ,  1.5072e-07 , &
        1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 , &
        1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 , &
        1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 ,  1.5000e-07 , &
        1.5000e-07 ,  1.5000e-07 /)
       chi_mls(7,1:12) = (/ &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 /)
       chi_mls(7,13:59) = (/ &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 ,  0.2090 ,  0.2090 ,  0.2090 , &
        0.2090 ,  0.2090 /)

      end subroutine lwatmref

!***************************************************************************

      subroutine lwavplank 2
!***************************************************************************

      save
 
      totplnk(1:50,  1) = (/ &
      0.14783e-05 ,0.15006e-05 ,0.15230e-05 ,0.15455e-05 ,0.15681e-05 , &
      0.15908e-05 ,0.16136e-05 ,0.16365e-05 ,0.16595e-05 ,0.16826e-05 , &
      0.17059e-05 ,0.17292e-05 ,0.17526e-05 ,0.17762e-05 ,0.17998e-05 , &
      0.18235e-05 ,0.18473e-05 ,0.18712e-05 ,0.18953e-05 ,0.19194e-05 , &
      0.19435e-05 ,0.19678e-05 ,0.19922e-05 ,0.20166e-05 ,0.20412e-05 , &
      0.20658e-05 ,0.20905e-05 ,0.21153e-05 ,0.21402e-05 ,0.21652e-05 , &
      0.21902e-05 ,0.22154e-05 ,0.22406e-05 ,0.22659e-05 ,0.22912e-05 , &
      0.23167e-05 ,0.23422e-05 ,0.23678e-05 ,0.23934e-05 ,0.24192e-05 , &
      0.24450e-05 ,0.24709e-05 ,0.24968e-05 ,0.25229e-05 ,0.25490e-05 , &
      0.25751e-05 ,0.26014e-05 ,0.26277e-05 ,0.26540e-05 ,0.26805e-05 /)
      totplnk(51:100,  1) = (/ &
      0.27070e-05 ,0.27335e-05 ,0.27602e-05 ,0.27869e-05 ,0.28136e-05 , &
      0.28404e-05 ,0.28673e-05 ,0.28943e-05 ,0.29213e-05 ,0.29483e-05 , &
      0.29754e-05 ,0.30026e-05 ,0.30298e-05 ,0.30571e-05 ,0.30845e-05 , &
      0.31119e-05 ,0.31393e-05 ,0.31669e-05 ,0.31944e-05 ,0.32220e-05 , &
      0.32497e-05 ,0.32774e-05 ,0.33052e-05 ,0.33330e-05 ,0.33609e-05 , &
      0.33888e-05 ,0.34168e-05 ,0.34448e-05 ,0.34729e-05 ,0.35010e-05 , &
      0.35292e-05 ,0.35574e-05 ,0.35857e-05 ,0.36140e-05 ,0.36424e-05 , &
      0.36708e-05 ,0.36992e-05 ,0.37277e-05 ,0.37563e-05 ,0.37848e-05 , &
      0.38135e-05 ,0.38421e-05 ,0.38708e-05 ,0.38996e-05 ,0.39284e-05 , &
      0.39572e-05 ,0.39861e-05 ,0.40150e-05 ,0.40440e-05 ,0.40730e-05 /)
      totplnk(101:150,  1) = (/ &
      0.41020e-05 ,0.41311e-05 ,0.41602e-05 ,0.41893e-05 ,0.42185e-05 , &
      0.42477e-05 ,0.42770e-05 ,0.43063e-05 ,0.43356e-05 ,0.43650e-05 , &
      0.43944e-05 ,0.44238e-05 ,0.44533e-05 ,0.44828e-05 ,0.45124e-05 , &
      0.45419e-05 ,0.45715e-05 ,0.46012e-05 ,0.46309e-05 ,0.46606e-05 , &
      0.46903e-05 ,0.47201e-05 ,0.47499e-05 ,0.47797e-05 ,0.48096e-05 , &
      0.48395e-05 ,0.48695e-05 ,0.48994e-05 ,0.49294e-05 ,0.49594e-05 , &
      0.49895e-05 ,0.50196e-05 ,0.50497e-05 ,0.50798e-05 ,0.51100e-05 , &
      0.51402e-05 ,0.51704e-05 ,0.52007e-05 ,0.52309e-05 ,0.52612e-05 , &
      0.52916e-05 ,0.53219e-05 ,0.53523e-05 ,0.53827e-05 ,0.54132e-05 , &
      0.54436e-05 ,0.54741e-05 ,0.55047e-05 ,0.55352e-05 ,0.55658e-05 /)
      totplnk(151:181,  1) = (/ &
      0.55964e-05 ,0.56270e-05 ,0.56576e-05 ,0.56883e-05 ,0.57190e-05 , &
      0.57497e-05 ,0.57804e-05 ,0.58112e-05 ,0.58420e-05 ,0.58728e-05 , &
      0.59036e-05 ,0.59345e-05 ,0.59653e-05 ,0.59962e-05 ,0.60272e-05 , &
      0.60581e-05 ,0.60891e-05 ,0.61201e-05 ,0.61511e-05 ,0.61821e-05 , &
      0.62131e-05 ,0.62442e-05 ,0.62753e-05 ,0.63064e-05 ,0.63376e-05 , &
      0.63687e-05 ,0.63998e-05 ,0.64310e-05 ,0.64622e-05 ,0.64935e-05 , &
      0.65247e-05 /)
      totplnk(1:50,  2) = (/ &
      0.20262e-05 ,0.20757e-05 ,0.21257e-05 ,0.21763e-05 ,0.22276e-05 , &
      0.22794e-05 ,0.23319e-05 ,0.23849e-05 ,0.24386e-05 ,0.24928e-05 , &
      0.25477e-05 ,0.26031e-05 ,0.26591e-05 ,0.27157e-05 ,0.27728e-05 , &
      0.28306e-05 ,0.28889e-05 ,0.29478e-05 ,0.30073e-05 ,0.30673e-05 , &
      0.31279e-05 ,0.31890e-05 ,0.32507e-05 ,0.33129e-05 ,0.33757e-05 , &
      0.34391e-05 ,0.35029e-05 ,0.35674e-05 ,0.36323e-05 ,0.36978e-05 , &
      0.37638e-05 ,0.38304e-05 ,0.38974e-05 ,0.39650e-05 ,0.40331e-05 , &
      0.41017e-05 ,0.41708e-05 ,0.42405e-05 ,0.43106e-05 ,0.43812e-05 , &
      0.44524e-05 ,0.45240e-05 ,0.45961e-05 ,0.46687e-05 ,0.47418e-05 , &
      0.48153e-05 ,0.48894e-05 ,0.49639e-05 ,0.50389e-05 ,0.51143e-05 /)
      totplnk(51:100,  2) = (/ &
      0.51902e-05 ,0.52666e-05 ,0.53434e-05 ,0.54207e-05 ,0.54985e-05 , &
      0.55767e-05 ,0.56553e-05 ,0.57343e-05 ,0.58139e-05 ,0.58938e-05 , &
      0.59742e-05 ,0.60550e-05 ,0.61362e-05 ,0.62179e-05 ,0.63000e-05 , &
      0.63825e-05 ,0.64654e-05 ,0.65487e-05 ,0.66324e-05 ,0.67166e-05 , &
      0.68011e-05 ,0.68860e-05 ,0.69714e-05 ,0.70571e-05 ,0.71432e-05 , &
      0.72297e-05 ,0.73166e-05 ,0.74039e-05 ,0.74915e-05 ,0.75796e-05 , &
      0.76680e-05 ,0.77567e-05 ,0.78459e-05 ,0.79354e-05 ,0.80252e-05 , &
      0.81155e-05 ,0.82061e-05 ,0.82970e-05 ,0.83883e-05 ,0.84799e-05 , &
      0.85719e-05 ,0.86643e-05 ,0.87569e-05 ,0.88499e-05 ,0.89433e-05 , &
      0.90370e-05 ,0.91310e-05 ,0.92254e-05 ,0.93200e-05 ,0.94150e-05 /)
      totplnk(101:150,  2) = (/ &
      0.95104e-05 ,0.96060e-05 ,0.97020e-05 ,0.97982e-05 ,0.98948e-05 , &
      0.99917e-05 ,0.10089e-04 ,0.10186e-04 ,0.10284e-04 ,0.10382e-04 , &
      0.10481e-04 ,0.10580e-04 ,0.10679e-04 ,0.10778e-04 ,0.10877e-04 , &
      0.10977e-04 ,0.11077e-04 ,0.11178e-04 ,0.11279e-04 ,0.11380e-04 , &
      0.11481e-04 ,0.11583e-04 ,0.11684e-04 ,0.11786e-04 ,0.11889e-04 , &
      0.11992e-04 ,0.12094e-04 ,0.12198e-04 ,0.12301e-04 ,0.12405e-04 , &
      0.12509e-04 ,0.12613e-04 ,0.12717e-04 ,0.12822e-04 ,0.12927e-04 , &
      0.13032e-04 ,0.13138e-04 ,0.13244e-04 ,0.13349e-04 ,0.13456e-04 , &
      0.13562e-04 ,0.13669e-04 ,0.13776e-04 ,0.13883e-04 ,0.13990e-04 , &
      0.14098e-04 ,0.14206e-04 ,0.14314e-04 ,0.14422e-04 ,0.14531e-04 /)
      totplnk(151:181,  2) = (/ &
      0.14639e-04 ,0.14748e-04 ,0.14857e-04 ,0.14967e-04 ,0.15076e-04 , &
      0.15186e-04 ,0.15296e-04 ,0.15407e-04 ,0.15517e-04 ,0.15628e-04 , &
      0.15739e-04 ,0.15850e-04 ,0.15961e-04 ,0.16072e-04 ,0.16184e-04 , &
      0.16296e-04 ,0.16408e-04 ,0.16521e-04 ,0.16633e-04 ,0.16746e-04 , &
      0.16859e-04 ,0.16972e-04 ,0.17085e-04 ,0.17198e-04 ,0.17312e-04 , &
      0.17426e-04 ,0.17540e-04 ,0.17654e-04 ,0.17769e-04 ,0.17883e-04 , &
      0.17998e-04 /)
      totplnk(1:50, 3) = (/ &
      1.34822e-06 ,1.39134e-06 ,1.43530e-06 ,1.48010e-06 ,1.52574e-06 , &
      1.57222e-06 ,1.61956e-06 ,1.66774e-06 ,1.71678e-06 ,1.76666e-06 , &
      1.81741e-06 ,1.86901e-06 ,1.92147e-06 ,1.97479e-06 ,2.02898e-06 , &
      2.08402e-06 ,2.13993e-06 ,2.19671e-06 ,2.25435e-06 ,2.31285e-06 , &
      2.37222e-06 ,2.43246e-06 ,2.49356e-06 ,2.55553e-06 ,2.61837e-06 , &
      2.68207e-06 ,2.74664e-06 ,2.81207e-06 ,2.87837e-06 ,2.94554e-06 , &
      3.01356e-06 ,3.08245e-06 ,3.15221e-06 ,3.22282e-06 ,3.29429e-06 , &
      3.36662e-06 ,3.43982e-06 ,3.51386e-06 ,3.58876e-06 ,3.66451e-06 , &
      3.74112e-06 ,3.81857e-06 ,3.89688e-06 ,3.97602e-06 ,4.05601e-06 , &
      4.13685e-06 ,4.21852e-06 ,4.30104e-06 ,4.38438e-06 ,4.46857e-06 /)
      totplnk(51:100, 3) = (/ &
      4.55358e-06 ,4.63943e-06 ,4.72610e-06 ,4.81359e-06 ,4.90191e-06 , &
      4.99105e-06 ,5.08100e-06 ,5.17176e-06 ,5.26335e-06 ,5.35573e-06 , &
      5.44892e-06 ,5.54292e-06 ,5.63772e-06 ,5.73331e-06 ,5.82970e-06 , &
      5.92688e-06 ,6.02485e-06 ,6.12360e-06 ,6.22314e-06 ,6.32346e-06 , &
      6.42455e-06 ,6.52641e-06 ,6.62906e-06 ,6.73247e-06 ,6.83664e-06 , &
      6.94156e-06 ,7.04725e-06 ,7.15370e-06 ,7.26089e-06 ,7.36883e-06 , &
      7.47752e-06 ,7.58695e-06 ,7.69712e-06 ,7.80801e-06 ,7.91965e-06 , &
      8.03201e-06 ,8.14510e-06 ,8.25891e-06 ,8.37343e-06 ,8.48867e-06 , &
      8.60463e-06 ,8.72128e-06 ,8.83865e-06 ,8.95672e-06 ,9.07548e-06 , &
      9.19495e-06 ,9.31510e-06 ,9.43594e-06 ,9.55745e-06 ,9.67966e-06 /)
      totplnk(101:150, 3) = (/ &
      9.80254e-06 ,9.92609e-06 ,1.00503e-05 ,1.01752e-05 ,1.03008e-05 , &
      1.04270e-05 ,1.05539e-05 ,1.06814e-05 ,1.08096e-05 ,1.09384e-05 , &
      1.10679e-05 ,1.11980e-05 ,1.13288e-05 ,1.14601e-05 ,1.15922e-05 , &
      1.17248e-05 ,1.18581e-05 ,1.19920e-05 ,1.21265e-05 ,1.22616e-05 , &
      1.23973e-05 ,1.25337e-05 ,1.26706e-05 ,1.28081e-05 ,1.29463e-05 , &
      1.30850e-05 ,1.32243e-05 ,1.33642e-05 ,1.35047e-05 ,1.36458e-05 , &
      1.37875e-05 ,1.39297e-05 ,1.40725e-05 ,1.42159e-05 ,1.43598e-05 , &
      1.45044e-05 ,1.46494e-05 ,1.47950e-05 ,1.49412e-05 ,1.50879e-05 , &
      1.52352e-05 ,1.53830e-05 ,1.55314e-05 ,1.56803e-05 ,1.58297e-05 , &
      1.59797e-05 ,1.61302e-05 ,1.62812e-05 ,1.64327e-05 ,1.65848e-05 /)
      totplnk(151:181, 3) = (/ &
      1.67374e-05 ,1.68904e-05 ,1.70441e-05 ,1.71982e-05 ,1.73528e-05 , &
      1.75079e-05 ,1.76635e-05 ,1.78197e-05 ,1.79763e-05 ,1.81334e-05 , &
      1.82910e-05 ,1.84491e-05 ,1.86076e-05 ,1.87667e-05 ,1.89262e-05 , &
      1.90862e-05 ,1.92467e-05 ,1.94076e-05 ,1.95690e-05 ,1.97309e-05 , &
      1.98932e-05 ,2.00560e-05 ,2.02193e-05 ,2.03830e-05 ,2.05472e-05 , &
      2.07118e-05 ,2.08768e-05 ,2.10423e-05 ,2.12083e-05 ,2.13747e-05 , &
      2.15414e-05 /)
      totplnk(1:50, 4) = (/ &
      8.90528e-07 ,9.24222e-07 ,9.58757e-07 ,9.94141e-07 ,1.03038e-06 , &
      1.06748e-06 ,1.10545e-06 ,1.14430e-06 ,1.18403e-06 ,1.22465e-06 , &
      1.26618e-06 ,1.30860e-06 ,1.35193e-06 ,1.39619e-06 ,1.44136e-06 , &
      1.48746e-06 ,1.53449e-06 ,1.58246e-06 ,1.63138e-06 ,1.68124e-06 , &
      1.73206e-06 ,1.78383e-06 ,1.83657e-06 ,1.89028e-06 ,1.94495e-06 , &
      2.00060e-06 ,2.05724e-06 ,2.11485e-06 ,2.17344e-06 ,2.23303e-06 , &
      2.29361e-06 ,2.35519e-06 ,2.41777e-06 ,2.48134e-06 ,2.54592e-06 , &
      2.61151e-06 ,2.67810e-06 ,2.74571e-06 ,2.81433e-06 ,2.88396e-06 , &
      2.95461e-06 ,3.02628e-06 ,3.09896e-06 ,3.17267e-06 ,3.24741e-06 , &
      3.32316e-06 ,3.39994e-06 ,3.47774e-06 ,3.55657e-06 ,3.63642e-06 /)
      totplnk(51:100, 4) = (/ &
      3.71731e-06 ,3.79922e-06 ,3.88216e-06 ,3.96612e-06 ,4.05112e-06 , &
      4.13714e-06 ,4.22419e-06 ,4.31227e-06 ,4.40137e-06 ,4.49151e-06 , &
      4.58266e-06 ,4.67485e-06 ,4.76806e-06 ,4.86229e-06 ,4.95754e-06 , &
      5.05383e-06 ,5.15113e-06 ,5.24946e-06 ,5.34879e-06 ,5.44916e-06 , &
      5.55053e-06 ,5.65292e-06 ,5.75632e-06 ,5.86073e-06 ,5.96616e-06 , &
      6.07260e-06 ,6.18003e-06 ,6.28848e-06 ,6.39794e-06 ,6.50838e-06 , &
      6.61983e-06 ,6.73229e-06 ,6.84573e-06 ,6.96016e-06 ,7.07559e-06 , &
      7.19200e-06 ,7.30940e-06 ,7.42779e-06 ,7.54715e-06 ,7.66749e-06 , &
      7.78882e-06 ,7.91110e-06 ,8.03436e-06 ,8.15859e-06 ,8.28379e-06 , &
      8.40994e-06 ,8.53706e-06 ,8.66515e-06 ,8.79418e-06 ,8.92416e-06 /)
      totplnk(101:150, 4) = (/ &
      9.05510e-06 ,9.18697e-06 ,9.31979e-06 ,9.45356e-06 ,9.58826e-06 , &
      9.72389e-06 ,9.86046e-06 ,9.99793e-06 ,1.01364e-05 ,1.02757e-05 , &
      1.04159e-05 ,1.05571e-05 ,1.06992e-05 ,1.08422e-05 ,1.09861e-05 , &
      1.11309e-05 ,1.12766e-05 ,1.14232e-05 ,1.15707e-05 ,1.17190e-05 , &
      1.18683e-05 ,1.20184e-05 ,1.21695e-05 ,1.23214e-05 ,1.24741e-05 , &
      1.26277e-05 ,1.27822e-05 ,1.29376e-05 ,1.30939e-05 ,1.32509e-05 , &
      1.34088e-05 ,1.35676e-05 ,1.37273e-05 ,1.38877e-05 ,1.40490e-05 , &
      1.42112e-05 ,1.43742e-05 ,1.45380e-05 ,1.47026e-05 ,1.48680e-05 , &
      1.50343e-05 ,1.52014e-05 ,1.53692e-05 ,1.55379e-05 ,1.57074e-05 , &
      1.58778e-05 ,1.60488e-05 ,1.62207e-05 ,1.63934e-05 ,1.65669e-05 /)
      totplnk(151:181, 4) = (/ &
      1.67411e-05 ,1.69162e-05 ,1.70920e-05 ,1.72685e-05 ,1.74459e-05 , &
      1.76240e-05 ,1.78029e-05 ,1.79825e-05 ,1.81629e-05 ,1.83440e-05 , &
      1.85259e-05 ,1.87086e-05 ,1.88919e-05 ,1.90760e-05 ,1.92609e-05 , &
      1.94465e-05 ,1.96327e-05 ,1.98199e-05 ,2.00076e-05 ,2.01961e-05 , &
      2.03853e-05 ,2.05752e-05 ,2.07658e-05 ,2.09571e-05 ,2.11491e-05 , &
      2.13418e-05 ,2.15352e-05 ,2.17294e-05 ,2.19241e-05 ,2.21196e-05 , &
      2.23158e-05 /)
      totplnk(1:50, 5) = (/ &
      5.70230e-07 ,5.94788e-07 ,6.20085e-07 ,6.46130e-07 ,6.72936e-07 , &
      7.00512e-07 ,7.28869e-07 ,7.58019e-07 ,7.87971e-07 ,8.18734e-07 , &
      8.50320e-07 ,8.82738e-07 ,9.15999e-07 ,9.50110e-07 ,9.85084e-07 , &
      1.02093e-06 ,1.05765e-06 ,1.09527e-06 ,1.13378e-06 ,1.17320e-06 , &
      1.21353e-06 ,1.25479e-06 ,1.29698e-06 ,1.34011e-06 ,1.38419e-06 , &
      1.42923e-06 ,1.47523e-06 ,1.52221e-06 ,1.57016e-06 ,1.61910e-06 , &
      1.66904e-06 ,1.71997e-06 ,1.77192e-06 ,1.82488e-06 ,1.87886e-06 , &
      1.93387e-06 ,1.98991e-06 ,2.04699e-06 ,2.10512e-06 ,2.16430e-06 , &
      2.22454e-06 ,2.28584e-06 ,2.34821e-06 ,2.41166e-06 ,2.47618e-06 , &
      2.54178e-06 ,2.60847e-06 ,2.67626e-06 ,2.74514e-06 ,2.81512e-06 /)
      totplnk(51:100, 5) = (/ &
      2.88621e-06 ,2.95841e-06 ,3.03172e-06 ,3.10615e-06 ,3.18170e-06 , &
      3.25838e-06 ,3.33618e-06 ,3.41511e-06 ,3.49518e-06 ,3.57639e-06 , &
      3.65873e-06 ,3.74221e-06 ,3.82684e-06 ,3.91262e-06 ,3.99955e-06 , &
      4.08763e-06 ,4.17686e-06 ,4.26725e-06 ,4.35880e-06 ,4.45150e-06 , &
      4.54537e-06 ,4.64039e-06 ,4.73659e-06 ,4.83394e-06 ,4.93246e-06 , &
      5.03215e-06 ,5.13301e-06 ,5.23504e-06 ,5.33823e-06 ,5.44260e-06 , &
      5.54814e-06 ,5.65484e-06 ,5.76272e-06 ,5.87177e-06 ,5.98199e-06 , &
      6.09339e-06 ,6.20596e-06 ,6.31969e-06 ,6.43460e-06 ,6.55068e-06 , &
      6.66793e-06 ,6.78636e-06 ,6.90595e-06 ,7.02670e-06 ,7.14863e-06 , &
      7.27173e-06 ,7.39599e-06 ,7.52142e-06 ,7.64802e-06 ,7.77577e-06 /)
      totplnk(101:150, 5) = (/ &
      7.90469e-06 ,8.03477e-06 ,8.16601e-06 ,8.29841e-06 ,8.43198e-06 , &
      8.56669e-06 ,8.70256e-06 ,8.83957e-06 ,8.97775e-06 ,9.11706e-06 , &
      9.25753e-06 ,9.39915e-06 ,9.54190e-06 ,9.68580e-06 ,9.83085e-06 , &
      9.97704e-06 ,1.01243e-05 ,1.02728e-05 ,1.04224e-05 ,1.05731e-05 , &
      1.07249e-05 ,1.08779e-05 ,1.10320e-05 ,1.11872e-05 ,1.13435e-05 , &
      1.15009e-05 ,1.16595e-05 ,1.18191e-05 ,1.19799e-05 ,1.21418e-05 , &
      1.23048e-05 ,1.24688e-05 ,1.26340e-05 ,1.28003e-05 ,1.29676e-05 , &
      1.31361e-05 ,1.33056e-05 ,1.34762e-05 ,1.36479e-05 ,1.38207e-05 , &
      1.39945e-05 ,1.41694e-05 ,1.43454e-05 ,1.45225e-05 ,1.47006e-05 , &
      1.48797e-05 ,1.50600e-05 ,1.52413e-05 ,1.54236e-05 ,1.56070e-05 /)
      totplnk(151:181, 5) = (/ &
      1.57914e-05 ,1.59768e-05 ,1.61633e-05 ,1.63509e-05 ,1.65394e-05 , &
      1.67290e-05 ,1.69197e-05 ,1.71113e-05 ,1.73040e-05 ,1.74976e-05 , &
      1.76923e-05 ,1.78880e-05 ,1.80847e-05 ,1.82824e-05 ,1.84811e-05 , &
      1.86808e-05 ,1.88814e-05 ,1.90831e-05 ,1.92857e-05 ,1.94894e-05 , &
      1.96940e-05 ,1.98996e-05 ,2.01061e-05 ,2.03136e-05 ,2.05221e-05 , &
      2.07316e-05 ,2.09420e-05 ,2.11533e-05 ,2.13657e-05 ,2.15789e-05 , &
      2.17931e-05 /)
      totplnk(1:50, 6) = (/ &
      2.73493e-07 ,2.87408e-07 ,3.01848e-07 ,3.16825e-07 ,3.32352e-07 , &
      3.48439e-07 ,3.65100e-07 ,3.82346e-07 ,4.00189e-07 ,4.18641e-07 , &
      4.37715e-07 ,4.57422e-07 ,4.77774e-07 ,4.98784e-07 ,5.20464e-07 , &
      5.42824e-07 ,5.65879e-07 ,5.89638e-07 ,6.14115e-07 ,6.39320e-07 , &
      6.65266e-07 ,6.91965e-07 ,7.19427e-07 ,7.47666e-07 ,7.76691e-07 , &
      8.06516e-07 ,8.37151e-07 ,8.68607e-07 ,9.00896e-07 ,9.34029e-07 , &
      9.68018e-07 ,1.00287e-06 ,1.03860e-06 ,1.07522e-06 ,1.11274e-06 , &
      1.15117e-06 ,1.19052e-06 ,1.23079e-06 ,1.27201e-06 ,1.31418e-06 , &
      1.35731e-06 ,1.40141e-06 ,1.44650e-06 ,1.49257e-06 ,1.53965e-06 , &
      1.58773e-06 ,1.63684e-06 ,1.68697e-06 ,1.73815e-06 ,1.79037e-06 /)
      totplnk(51:100, 6) = (/ &
      1.84365e-06 ,1.89799e-06 ,1.95341e-06 ,2.00991e-06 ,2.06750e-06 , &
      2.12619e-06 ,2.18599e-06 ,2.24691e-06 ,2.30895e-06 ,2.37212e-06 , &
      2.43643e-06 ,2.50189e-06 ,2.56851e-06 ,2.63628e-06 ,2.70523e-06 , &
      2.77536e-06 ,2.84666e-06 ,2.91916e-06 ,2.99286e-06 ,3.06776e-06 , &
      3.14387e-06 ,3.22120e-06 ,3.29975e-06 ,3.37953e-06 ,3.46054e-06 , &
      3.54280e-06 ,3.62630e-06 ,3.71105e-06 ,3.79707e-06 ,3.88434e-06 , &
      3.97288e-06 ,4.06270e-06 ,4.15380e-06 ,4.24617e-06 ,4.33984e-06 , &
      4.43479e-06 ,4.53104e-06 ,4.62860e-06 ,4.72746e-06 ,4.82763e-06 , &
      4.92911e-06 ,5.03191e-06 ,5.13603e-06 ,5.24147e-06 ,5.34824e-06 , &
      5.45634e-06 ,5.56578e-06 ,5.67656e-06 ,5.78867e-06 ,5.90213e-06 /)
      totplnk(101:150, 6) = (/ &
      6.01694e-06 ,6.13309e-06 ,6.25060e-06 ,6.36947e-06 ,6.48968e-06 , &
      6.61126e-06 ,6.73420e-06 ,6.85850e-06 ,6.98417e-06 ,7.11120e-06 , &
      7.23961e-06 ,7.36938e-06 ,7.50053e-06 ,7.63305e-06 ,7.76694e-06 , &
      7.90221e-06 ,8.03887e-06 ,8.17690e-06 ,8.31632e-06 ,8.45710e-06 , &
      8.59928e-06 ,8.74282e-06 ,8.88776e-06 ,9.03409e-06 ,9.18179e-06 , &
      9.33088e-06 ,9.48136e-06 ,9.63323e-06 ,9.78648e-06 ,9.94111e-06 , &
      1.00971e-05 ,1.02545e-05 ,1.04133e-05 ,1.05735e-05 ,1.07351e-05 , &
      1.08980e-05 ,1.10624e-05 ,1.12281e-05 ,1.13952e-05 ,1.15637e-05 , &
      1.17335e-05 ,1.19048e-05 ,1.20774e-05 ,1.22514e-05 ,1.24268e-05 , &
      1.26036e-05 ,1.27817e-05 ,1.29612e-05 ,1.31421e-05 ,1.33244e-05 /)
      totplnk(151:181, 6) = (/ &
      1.35080e-05 ,1.36930e-05 ,1.38794e-05 ,1.40672e-05 ,1.42563e-05 , &
      1.44468e-05 ,1.46386e-05 ,1.48318e-05 ,1.50264e-05 ,1.52223e-05 , &
      1.54196e-05 ,1.56182e-05 ,1.58182e-05 ,1.60196e-05 ,1.62223e-05 , &
      1.64263e-05 ,1.66317e-05 ,1.68384e-05 ,1.70465e-05 ,1.72559e-05 , &
      1.74666e-05 ,1.76787e-05 ,1.78921e-05 ,1.81069e-05 ,1.83230e-05 , &
      1.85404e-05 ,1.87591e-05 ,1.89791e-05 ,1.92005e-05 ,1.94232e-05 , &
      1.96471e-05 /)
      totplnk(1:50, 7) = (/ &
      1.25349e-07 ,1.32735e-07 ,1.40458e-07 ,1.48527e-07 ,1.56954e-07 , &
      1.65748e-07 ,1.74920e-07 ,1.84481e-07 ,1.94443e-07 ,2.04814e-07 , &
      2.15608e-07 ,2.26835e-07 ,2.38507e-07 ,2.50634e-07 ,2.63229e-07 , &
      2.76301e-07 ,2.89864e-07 ,3.03930e-07 ,3.18508e-07 ,3.33612e-07 , &
      3.49253e-07 ,3.65443e-07 ,3.82195e-07 ,3.99519e-07 ,4.17428e-07 , &
      4.35934e-07 ,4.55050e-07 ,4.74785e-07 ,4.95155e-07 ,5.16170e-07 , &
      5.37844e-07 ,5.60186e-07 ,5.83211e-07 ,6.06929e-07 ,6.31355e-07 , &
      6.56498e-07 ,6.82373e-07 ,7.08990e-07 ,7.36362e-07 ,7.64501e-07 , &
      7.93420e-07 ,8.23130e-07 ,8.53643e-07 ,8.84971e-07 ,9.17128e-07 , &
      9.50123e-07 ,9.83969e-07 ,1.01868e-06 ,1.05426e-06 ,1.09073e-06 /)
      totplnk(51:100, 7) = (/ &
      1.12810e-06 ,1.16638e-06 ,1.20558e-06 ,1.24572e-06 ,1.28680e-06 , &
      1.32883e-06 ,1.37183e-06 ,1.41581e-06 ,1.46078e-06 ,1.50675e-06 , &
      1.55374e-06 ,1.60174e-06 ,1.65078e-06 ,1.70087e-06 ,1.75200e-06 , &
      1.80421e-06 ,1.85749e-06 ,1.91186e-06 ,1.96732e-06 ,2.02389e-06 , &
      2.08159e-06 ,2.14040e-06 ,2.20035e-06 ,2.26146e-06 ,2.32372e-06 , &
      2.38714e-06 ,2.45174e-06 ,2.51753e-06 ,2.58451e-06 ,2.65270e-06 , &
      2.72210e-06 ,2.79272e-06 ,2.86457e-06 ,2.93767e-06 ,3.01201e-06 , &
      3.08761e-06 ,3.16448e-06 ,3.24261e-06 ,3.32204e-06 ,3.40275e-06 , &
      3.48476e-06 ,3.56808e-06 ,3.65271e-06 ,3.73866e-06 ,3.82595e-06 , &
      3.91456e-06 ,4.00453e-06 ,4.09584e-06 ,4.18851e-06 ,4.28254e-06 /)
      totplnk(101:150, 7) = (/ &
      4.37796e-06 ,4.47475e-06 ,4.57293e-06 ,4.67249e-06 ,4.77346e-06 , &
      4.87583e-06 ,4.97961e-06 ,5.08481e-06 ,5.19143e-06 ,5.29948e-06 , &
      5.40896e-06 ,5.51989e-06 ,5.63226e-06 ,5.74608e-06 ,5.86136e-06 , &
      5.97810e-06 ,6.09631e-06 ,6.21597e-06 ,6.33713e-06 ,6.45976e-06 , &
      6.58388e-06 ,6.70950e-06 ,6.83661e-06 ,6.96521e-06 ,7.09531e-06 , &
      7.22692e-06 ,7.36005e-06 ,7.49468e-06 ,7.63084e-06 ,7.76851e-06 , &
      7.90773e-06 ,8.04846e-06 ,8.19072e-06 ,8.33452e-06 ,8.47985e-06 , &
      8.62674e-06 ,8.77517e-06 ,8.92514e-06 ,9.07666e-06 ,9.22975e-06 , &
      9.38437e-06 ,9.54057e-06 ,9.69832e-06 ,9.85762e-06 ,1.00185e-05 , &
      1.01810e-05 ,1.03450e-05 ,1.05106e-05 ,1.06777e-05 ,1.08465e-05 /)
      totplnk(151:181, 7) = (/ &
      1.10168e-05 ,1.11887e-05 ,1.13621e-05 ,1.15372e-05 ,1.17138e-05 , &
      1.18920e-05 ,1.20718e-05 ,1.22532e-05 ,1.24362e-05 ,1.26207e-05 , &
      1.28069e-05 ,1.29946e-05 ,1.31839e-05 ,1.33749e-05 ,1.35674e-05 , &
      1.37615e-05 ,1.39572e-05 ,1.41544e-05 ,1.43533e-05 ,1.45538e-05 , &
      1.47558e-05 ,1.49595e-05 ,1.51647e-05 ,1.53716e-05 ,1.55800e-05 , &
      1.57900e-05 ,1.60017e-05 ,1.62149e-05 ,1.64296e-05 ,1.66460e-05 , &
      1.68640e-05 /)
      totplnk(1:50, 8) = (/ &
      6.74445e-08 ,7.18176e-08 ,7.64153e-08 ,8.12456e-08 ,8.63170e-08 , &
      9.16378e-08 ,9.72168e-08 ,1.03063e-07 ,1.09184e-07 ,1.15591e-07 , &
      1.22292e-07 ,1.29296e-07 ,1.36613e-07 ,1.44253e-07 ,1.52226e-07 , &
      1.60540e-07 ,1.69207e-07 ,1.78236e-07 ,1.87637e-07 ,1.97421e-07 , &
      2.07599e-07 ,2.18181e-07 ,2.29177e-07 ,2.40598e-07 ,2.52456e-07 , &
      2.64761e-07 ,2.77523e-07 ,2.90755e-07 ,3.04468e-07 ,3.18673e-07 , &
      3.33381e-07 ,3.48603e-07 ,3.64352e-07 ,3.80638e-07 ,3.97474e-07 , &
      4.14871e-07 ,4.32841e-07 ,4.51395e-07 ,4.70547e-07 ,4.90306e-07 , &
      5.10687e-07 ,5.31699e-07 ,5.53357e-07 ,5.75670e-07 ,5.98652e-07 , &
      6.22315e-07 ,6.46672e-07 ,6.71731e-07 ,6.97511e-07 ,7.24018e-07 /)
      totplnk(51:100, 8) = (/ &
      7.51266e-07 ,7.79269e-07 ,8.08038e-07 ,8.37584e-07 ,8.67922e-07 , &
      8.99061e-07 ,9.31016e-07 ,9.63797e-07 ,9.97417e-07 ,1.03189e-06 , &
      1.06722e-06 ,1.10343e-06 ,1.14053e-06 ,1.17853e-06 ,1.21743e-06 , &
      1.25726e-06 ,1.29803e-06 ,1.33974e-06 ,1.38241e-06 ,1.42606e-06 , &
      1.47068e-06 ,1.51630e-06 ,1.56293e-06 ,1.61056e-06 ,1.65924e-06 , &
      1.70894e-06 ,1.75971e-06 ,1.81153e-06 ,1.86443e-06 ,1.91841e-06 , &
      1.97350e-06 ,2.02968e-06 ,2.08699e-06 ,2.14543e-06 ,2.20500e-06 , &
      2.26573e-06 ,2.32762e-06 ,2.39068e-06 ,2.45492e-06 ,2.52036e-06 , &
      2.58700e-06 ,2.65485e-06 ,2.72393e-06 ,2.79424e-06 ,2.86580e-06 , &
      2.93861e-06 ,3.01269e-06 ,3.08803e-06 ,3.16467e-06 ,3.24259e-06 /)
      totplnk(101:150, 8) = (/ &
      3.32181e-06 ,3.40235e-06 ,3.48420e-06 ,3.56739e-06 ,3.65192e-06 , &
      3.73779e-06 ,3.82502e-06 ,3.91362e-06 ,4.00359e-06 ,4.09494e-06 , &
      4.18768e-06 ,4.28182e-06 ,4.37737e-06 ,4.47434e-06 ,4.57273e-06 , &
      4.67254e-06 ,4.77380e-06 ,4.87651e-06 ,4.98067e-06 ,5.08630e-06 , &
      5.19339e-06 ,5.30196e-06 ,5.41201e-06 ,5.52356e-06 ,5.63660e-06 , &
      5.75116e-06 ,5.86722e-06 ,5.98479e-06 ,6.10390e-06 ,6.22453e-06 , &
      6.34669e-06 ,6.47042e-06 ,6.59569e-06 ,6.72252e-06 ,6.85090e-06 , &
      6.98085e-06 ,7.11238e-06 ,7.24549e-06 ,7.38019e-06 ,7.51646e-06 , &
      7.65434e-06 ,7.79382e-06 ,7.93490e-06 ,8.07760e-06 ,8.22192e-06 , &
      8.36784e-06 ,8.51540e-06 ,8.66459e-06 ,8.81542e-06 ,8.96786e-06 /)
      totplnk(151:181, 8) = (/ &
      9.12197e-06 ,9.27772e-06 ,9.43513e-06 ,9.59419e-06 ,9.75490e-06 , &
      9.91728e-06 ,1.00813e-05 ,1.02471e-05 ,1.04144e-05 ,1.05835e-05 , &
      1.07543e-05 ,1.09267e-05 ,1.11008e-05 ,1.12766e-05 ,1.14541e-05 , &
      1.16333e-05 ,1.18142e-05 ,1.19969e-05 ,1.21812e-05 ,1.23672e-05 , &
      1.25549e-05 ,1.27443e-05 ,1.29355e-05 ,1.31284e-05 ,1.33229e-05 , &
      1.35193e-05 ,1.37173e-05 ,1.39170e-05 ,1.41185e-05 ,1.43217e-05 , &
      1.45267e-05 /)
      totplnk(1:50, 9) = (/ &
      2.61522e-08 ,2.80613e-08 ,3.00838e-08 ,3.22250e-08 ,3.44899e-08 , &
      3.68841e-08 ,3.94129e-08 ,4.20820e-08 ,4.48973e-08 ,4.78646e-08 , &
      5.09901e-08 ,5.42799e-08 ,5.77405e-08 ,6.13784e-08 ,6.52001e-08 , &
      6.92126e-08 ,7.34227e-08 ,7.78375e-08 ,8.24643e-08 ,8.73103e-08 , &
      9.23832e-08 ,9.76905e-08 ,1.03240e-07 ,1.09039e-07 ,1.15097e-07 , &
      1.21421e-07 ,1.28020e-07 ,1.34902e-07 ,1.42075e-07 ,1.49548e-07 , &
      1.57331e-07 ,1.65432e-07 ,1.73860e-07 ,1.82624e-07 ,1.91734e-07 , &
      2.01198e-07 ,2.11028e-07 ,2.21231e-07 ,2.31818e-07 ,2.42799e-07 , &
      2.54184e-07 ,2.65983e-07 ,2.78205e-07 ,2.90862e-07 ,3.03963e-07 , &
      3.17519e-07 ,3.31541e-07 ,3.46039e-07 ,3.61024e-07 ,3.76507e-07 /)
      totplnk(51:100, 9) = (/ &
      3.92498e-07 ,4.09008e-07 ,4.26050e-07 ,4.43633e-07 ,4.61769e-07 , &
      4.80469e-07 ,4.99744e-07 ,5.19606e-07 ,5.40067e-07 ,5.61136e-07 , &
      5.82828e-07 ,6.05152e-07 ,6.28120e-07 ,6.51745e-07 ,6.76038e-07 , &
      7.01010e-07 ,7.26674e-07 ,7.53041e-07 ,7.80124e-07 ,8.07933e-07 , &
      8.36482e-07 ,8.65781e-07 ,8.95845e-07 ,9.26683e-07 ,9.58308e-07 , &
      9.90732e-07 ,1.02397e-06 ,1.05803e-06 ,1.09292e-06 ,1.12866e-06 , &
      1.16526e-06 ,1.20274e-06 ,1.24109e-06 ,1.28034e-06 ,1.32050e-06 , &
      1.36158e-06 ,1.40359e-06 ,1.44655e-06 ,1.49046e-06 ,1.53534e-06 , &
      1.58120e-06 ,1.62805e-06 ,1.67591e-06 ,1.72478e-06 ,1.77468e-06 , &
      1.82561e-06 ,1.87760e-06 ,1.93066e-06 ,1.98479e-06 ,2.04000e-06 /)
      totplnk(101:150, 9) = (/ &
      2.09631e-06 ,2.15373e-06 ,2.21228e-06 ,2.27196e-06 ,2.33278e-06 , &
      2.39475e-06 ,2.45790e-06 ,2.52222e-06 ,2.58773e-06 ,2.65445e-06 , &
      2.72238e-06 ,2.79152e-06 ,2.86191e-06 ,2.93354e-06 ,3.00643e-06 , &
      3.08058e-06 ,3.15601e-06 ,3.23273e-06 ,3.31075e-06 ,3.39009e-06 , &
      3.47074e-06 ,3.55272e-06 ,3.63605e-06 ,3.72072e-06 ,3.80676e-06 , &
      3.89417e-06 ,3.98297e-06 ,4.07315e-06 ,4.16474e-06 ,4.25774e-06 , &
      4.35217e-06 ,4.44802e-06 ,4.54532e-06 ,4.64406e-06 ,4.74428e-06 , &
      4.84595e-06 ,4.94911e-06 ,5.05376e-06 ,5.15990e-06 ,5.26755e-06 , &
      5.37671e-06 ,5.48741e-06 ,5.59963e-06 ,5.71340e-06 ,5.82871e-06 , &
      5.94559e-06 ,6.06403e-06 ,6.18404e-06 ,6.30565e-06 ,6.42885e-06 /)
      totplnk(151:181, 9) = (/ &
      6.55364e-06 ,6.68004e-06 ,6.80806e-06 ,6.93771e-06 ,7.06898e-06 , &
      7.20190e-06 ,7.33646e-06 ,7.47267e-06 ,7.61056e-06 ,7.75010e-06 , &
      7.89133e-06 ,8.03423e-06 ,8.17884e-06 ,8.32514e-06 ,8.47314e-06 , &
      8.62284e-06 ,8.77427e-06 ,8.92743e-06 ,9.08231e-06 ,9.23893e-06 , &
      9.39729e-06 ,9.55741e-06 ,9.71927e-06 ,9.88291e-06 ,1.00483e-05 , &
      1.02155e-05 ,1.03844e-05 ,1.05552e-05 ,1.07277e-05 ,1.09020e-05 , &
      1.10781e-05 /)
      totplnk(1:50,10) = (/ &
      8.89300e-09 ,9.63263e-09 ,1.04235e-08 ,1.12685e-08 ,1.21703e-08 , &
      1.31321e-08 ,1.41570e-08 ,1.52482e-08 ,1.64090e-08 ,1.76428e-08 , &
      1.89533e-08 ,2.03441e-08 ,2.18190e-08 ,2.33820e-08 ,2.50370e-08 , &
      2.67884e-08 ,2.86402e-08 ,3.05969e-08 ,3.26632e-08 ,3.48436e-08 , &
      3.71429e-08 ,3.95660e-08 ,4.21179e-08 ,4.48040e-08 ,4.76294e-08 , &
      5.05996e-08 ,5.37201e-08 ,5.69966e-08 ,6.04349e-08 ,6.40411e-08 , &
      6.78211e-08 ,7.17812e-08 ,7.59276e-08 ,8.02670e-08 ,8.48059e-08 , &
      8.95508e-08 ,9.45090e-08 ,9.96873e-08 ,1.05093e-07 ,1.10733e-07 , &
      1.16614e-07 ,1.22745e-07 ,1.29133e-07 ,1.35786e-07 ,1.42711e-07 , &
      1.49916e-07 ,1.57410e-07 ,1.65202e-07 ,1.73298e-07 ,1.81709e-07 /)
      totplnk(51:100,10) = (/ &
      1.90441e-07 ,1.99505e-07 ,2.08908e-07 ,2.18660e-07 ,2.28770e-07 , &
      2.39247e-07 ,2.50101e-07 ,2.61340e-07 ,2.72974e-07 ,2.85013e-07 , &
      2.97467e-07 ,3.10345e-07 ,3.23657e-07 ,3.37413e-07 ,3.51623e-07 , &
      3.66298e-07 ,3.81448e-07 ,3.97082e-07 ,4.13212e-07 ,4.29848e-07 , &
      4.47000e-07 ,4.64680e-07 ,4.82898e-07 ,5.01664e-07 ,5.20991e-07 , &
      5.40888e-07 ,5.61369e-07 ,5.82440e-07 ,6.04118e-07 ,6.26410e-07 , &
      6.49329e-07 ,6.72887e-07 ,6.97095e-07 ,7.21964e-07 ,7.47506e-07 , &
      7.73732e-07 ,8.00655e-07 ,8.28287e-07 ,8.56635e-07 ,8.85717e-07 , &
      9.15542e-07 ,9.46122e-07 ,9.77469e-07 ,1.00960e-06 ,1.04251e-06 , &
      1.07623e-06 ,1.11077e-06 ,1.14613e-06 ,1.18233e-06 ,1.21939e-06 /)
      totplnk(101:150,10) = (/ &
      1.25730e-06 ,1.29610e-06 ,1.33578e-06 ,1.37636e-06 ,1.41785e-06 , &
      1.46027e-06 ,1.50362e-06 ,1.54792e-06 ,1.59319e-06 ,1.63942e-06 , &
      1.68665e-06 ,1.73487e-06 ,1.78410e-06 ,1.83435e-06 ,1.88564e-06 , &
      1.93797e-06 ,1.99136e-06 ,2.04582e-06 ,2.10137e-06 ,2.15801e-06 , &
      2.21576e-06 ,2.27463e-06 ,2.33462e-06 ,2.39577e-06 ,2.45806e-06 , &
      2.52153e-06 ,2.58617e-06 ,2.65201e-06 ,2.71905e-06 ,2.78730e-06 , &
      2.85678e-06 ,2.92749e-06 ,2.99946e-06 ,3.07269e-06 ,3.14720e-06 , &
      3.22299e-06 ,3.30007e-06 ,3.37847e-06 ,3.45818e-06 ,3.53923e-06 , &
      3.62161e-06 ,3.70535e-06 ,3.79046e-06 ,3.87695e-06 ,3.96481e-06 , &
      4.05409e-06 ,4.14477e-06 ,4.23687e-06 ,4.33040e-06 ,4.42538e-06 /)
      totplnk(151:181,10) = (/ &
      4.52180e-06 ,4.61969e-06 ,4.71905e-06 ,4.81991e-06 ,4.92226e-06 , &
      5.02611e-06 ,5.13148e-06 ,5.23839e-06 ,5.34681e-06 ,5.45681e-06 , &
      5.56835e-06 ,5.68146e-06 ,5.79614e-06 ,5.91242e-06 ,6.03030e-06 , &
      6.14978e-06 ,6.27088e-06 ,6.39360e-06 ,6.51798e-06 ,6.64398e-06 , &
      6.77165e-06 ,6.90099e-06 ,7.03198e-06 ,7.16468e-06 ,7.29906e-06 , &
      7.43514e-06 ,7.57294e-06 ,7.71244e-06 ,7.85369e-06 ,7.99666e-06 , &
      8.14138e-06 /)
      totplnk(1:50,11) = (/ &
      2.53767e-09 ,2.77242e-09 ,3.02564e-09 ,3.29851e-09 ,3.59228e-09 , &
      3.90825e-09 ,4.24777e-09 ,4.61227e-09 ,5.00322e-09 ,5.42219e-09 , &
      5.87080e-09 ,6.35072e-09 ,6.86370e-09 ,7.41159e-09 ,7.99628e-09 , &
      8.61974e-09 ,9.28404e-09 ,9.99130e-09 ,1.07437e-08 ,1.15436e-08 , &
      1.23933e-08 ,1.32953e-08 ,1.42522e-08 ,1.52665e-08 ,1.63410e-08 , &
      1.74786e-08 ,1.86820e-08 ,1.99542e-08 ,2.12985e-08 ,2.27179e-08 , &
      2.42158e-08 ,2.57954e-08 ,2.74604e-08 ,2.92141e-08 ,3.10604e-08 , &
      3.30029e-08 ,3.50457e-08 ,3.71925e-08 ,3.94476e-08 ,4.18149e-08 , &
      4.42991e-08 ,4.69043e-08 ,4.96352e-08 ,5.24961e-08 ,5.54921e-08 , &
      5.86277e-08 ,6.19081e-08 ,6.53381e-08 ,6.89231e-08 ,7.26681e-08 /)
      totplnk(51:100,11) = (/ &
      7.65788e-08 ,8.06604e-08 ,8.49187e-08 ,8.93591e-08 ,9.39879e-08 , &
      9.88106e-08 ,1.03834e-07 ,1.09063e-07 ,1.14504e-07 ,1.20165e-07 , &
      1.26051e-07 ,1.32169e-07 ,1.38525e-07 ,1.45128e-07 ,1.51982e-07 , &
      1.59096e-07 ,1.66477e-07 ,1.74132e-07 ,1.82068e-07 ,1.90292e-07 , &
      1.98813e-07 ,2.07638e-07 ,2.16775e-07 ,2.26231e-07 ,2.36015e-07 , &
      2.46135e-07 ,2.56599e-07 ,2.67415e-07 ,2.78592e-07 ,2.90137e-07 , &
      3.02061e-07 ,3.14371e-07 ,3.27077e-07 ,3.40186e-07 ,3.53710e-07 , &
      3.67655e-07 ,3.82031e-07 ,3.96848e-07 ,4.12116e-07 ,4.27842e-07 , &
      4.44039e-07 ,4.60713e-07 ,4.77876e-07 ,4.95537e-07 ,5.13706e-07 , &
      5.32392e-07 ,5.51608e-07 ,5.71360e-07 ,5.91662e-07 ,6.12521e-07 /)
      totplnk(101:150,11) = (/ &
      6.33950e-07 ,6.55958e-07 ,6.78556e-07 ,7.01753e-07 ,7.25562e-07 , &
      7.49992e-07 ,7.75055e-07 ,8.00760e-07 ,8.27120e-07 ,8.54145e-07 , &
      8.81845e-07 ,9.10233e-07 ,9.39318e-07 ,9.69113e-07 ,9.99627e-07 , &
      1.03087e-06 ,1.06286e-06 ,1.09561e-06 ,1.12912e-06 ,1.16340e-06 , &
      1.19848e-06 ,1.23435e-06 ,1.27104e-06 ,1.30855e-06 ,1.34690e-06 , &
      1.38609e-06 ,1.42614e-06 ,1.46706e-06 ,1.50886e-06 ,1.55155e-06 , &
      1.59515e-06 ,1.63967e-06 ,1.68512e-06 ,1.73150e-06 ,1.77884e-06 , &
      1.82715e-06 ,1.87643e-06 ,1.92670e-06 ,1.97797e-06 ,2.03026e-06 , &
      2.08356e-06 ,2.13791e-06 ,2.19330e-06 ,2.24975e-06 ,2.30728e-06 , &
      2.36589e-06 ,2.42560e-06 ,2.48641e-06 ,2.54835e-06 ,2.61142e-06 /)
      totplnk(151:181,11) = (/ &
      2.67563e-06 ,2.74100e-06 ,2.80754e-06 ,2.87526e-06 ,2.94417e-06 , &
      3.01429e-06 ,3.08562e-06 ,3.15819e-06 ,3.23199e-06 ,3.30704e-06 , &
      3.38336e-06 ,3.46096e-06 ,3.53984e-06 ,3.62002e-06 ,3.70151e-06 , &
      3.78433e-06 ,3.86848e-06 ,3.95399e-06 ,4.04084e-06 ,4.12907e-06 , &
      4.21868e-06 ,4.30968e-06 ,4.40209e-06 ,4.49592e-06 ,4.59117e-06 , &
      4.68786e-06 ,4.78600e-06 ,4.88561e-06 ,4.98669e-06 ,5.08926e-06 , &
      5.19332e-06 /)
      totplnk(1:50,12) = (/ &
      2.73921e-10 ,3.04500e-10 ,3.38056e-10 ,3.74835e-10 ,4.15099e-10 , &
      4.59126e-10 ,5.07214e-10 ,5.59679e-10 ,6.16857e-10 ,6.79103e-10 , &
      7.46796e-10 ,8.20335e-10 ,9.00144e-10 ,9.86671e-10 ,1.08039e-09 , &
      1.18180e-09 ,1.29142e-09 ,1.40982e-09 ,1.53757e-09 ,1.67529e-09 , &
      1.82363e-09 ,1.98327e-09 ,2.15492e-09 ,2.33932e-09 ,2.53726e-09 , &
      2.74957e-09 ,2.97710e-09 ,3.22075e-09 ,3.48145e-09 ,3.76020e-09 , &
      4.05801e-09 ,4.37595e-09 ,4.71513e-09 ,5.07672e-09 ,5.46193e-09 , &
      5.87201e-09 ,6.30827e-09 ,6.77205e-09 ,7.26480e-09 ,7.78794e-09 , &
      8.34304e-09 ,8.93163e-09 ,9.55537e-09 ,1.02159e-08 ,1.09151e-08 , &
      1.16547e-08 ,1.24365e-08 ,1.32625e-08 ,1.41348e-08 ,1.50554e-08 /)
      totplnk(51:100,12) = (/ &
      1.60264e-08 ,1.70500e-08 ,1.81285e-08 ,1.92642e-08 ,2.04596e-08 , &
      2.17171e-08 ,2.30394e-08 ,2.44289e-08 ,2.58885e-08 ,2.74209e-08 , &
      2.90290e-08 ,3.07157e-08 ,3.24841e-08 ,3.43371e-08 ,3.62782e-08 , &
      3.83103e-08 ,4.04371e-08 ,4.26617e-08 ,4.49878e-08 ,4.74190e-08 , &
      4.99589e-08 ,5.26113e-08 ,5.53801e-08 ,5.82692e-08 ,6.12826e-08 , &
      6.44245e-08 ,6.76991e-08 ,7.11105e-08 ,7.46634e-08 ,7.83621e-08 , &
      8.22112e-08 ,8.62154e-08 ,9.03795e-08 ,9.47081e-08 ,9.92066e-08 , &
      1.03879e-07 ,1.08732e-07 ,1.13770e-07 ,1.18998e-07 ,1.24422e-07 , &
      1.30048e-07 ,1.35880e-07 ,1.41924e-07 ,1.48187e-07 ,1.54675e-07 , &
      1.61392e-07 ,1.68346e-07 ,1.75543e-07 ,1.82988e-07 ,1.90688e-07 /)
      totplnk(101:150,12) = (/ &
      1.98650e-07 ,2.06880e-07 ,2.15385e-07 ,2.24172e-07 ,2.33247e-07 , &
      2.42617e-07 ,2.52289e-07 ,2.62272e-07 ,2.72571e-07 ,2.83193e-07 , &
      2.94147e-07 ,3.05440e-07 ,3.17080e-07 ,3.29074e-07 ,3.41430e-07 , &
      3.54155e-07 ,3.67259e-07 ,3.80747e-07 ,3.94631e-07 ,4.08916e-07 , &
      4.23611e-07 ,4.38725e-07 ,4.54267e-07 ,4.70245e-07 ,4.86666e-07 , &
      5.03541e-07 ,5.20879e-07 ,5.38687e-07 ,5.56975e-07 ,5.75751e-07 , &
      5.95026e-07 ,6.14808e-07 ,6.35107e-07 ,6.55932e-07 ,6.77293e-07 , &
      6.99197e-07 ,7.21656e-07 ,7.44681e-07 ,7.68278e-07 ,7.92460e-07 , &
      8.17235e-07 ,8.42614e-07 ,8.68606e-07 ,8.95223e-07 ,9.22473e-07 , &
      9.50366e-07 ,9.78915e-07 ,1.00813e-06 ,1.03802e-06 ,1.06859e-06 /)
      totplnk(151:181,12) = (/ &
      1.09986e-06 ,1.13184e-06 ,1.16453e-06 ,1.19796e-06 ,1.23212e-06 , &
      1.26703e-06 ,1.30270e-06 ,1.33915e-06 ,1.37637e-06 ,1.41440e-06 , &
      1.45322e-06 ,1.49286e-06 ,1.53333e-06 ,1.57464e-06 ,1.61679e-06 , &
      1.65981e-06 ,1.70370e-06 ,1.74847e-06 ,1.79414e-06 ,1.84071e-06 , &
      1.88821e-06 ,1.93663e-06 ,1.98599e-06 ,2.03631e-06 ,2.08759e-06 , &
      2.13985e-06 ,2.19310e-06 ,2.24734e-06 ,2.30260e-06 ,2.35888e-06 , &
      2.41619e-06 /)
      totplnk(1:50,13) = (/ &
      4.53634e-11 ,5.11435e-11 ,5.75754e-11 ,6.47222e-11 ,7.26531e-11 , &
      8.14420e-11 ,9.11690e-11 ,1.01921e-10 ,1.13790e-10 ,1.26877e-10 , &
      1.41288e-10 ,1.57140e-10 ,1.74555e-10 ,1.93665e-10 ,2.14613e-10 , &
      2.37548e-10 ,2.62633e-10 ,2.90039e-10 ,3.19948e-10 ,3.52558e-10 , &
      3.88073e-10 ,4.26716e-10 ,4.68719e-10 ,5.14331e-10 ,5.63815e-10 , &
      6.17448e-10 ,6.75526e-10 ,7.38358e-10 ,8.06277e-10 ,8.79625e-10 , &
      9.58770e-10 ,1.04410e-09 ,1.13602e-09 ,1.23495e-09 ,1.34135e-09 , &
      1.45568e-09 ,1.57845e-09 ,1.71017e-09 ,1.85139e-09 ,2.00268e-09 , &
      2.16464e-09 ,2.33789e-09 ,2.52309e-09 ,2.72093e-09 ,2.93212e-09 , &
      3.15740e-09 ,3.39757e-09 ,3.65341e-09 ,3.92579e-09 ,4.21559e-09 /)
      totplnk(51:100,13) = (/ &
      4.52372e-09 ,4.85115e-09 ,5.19886e-09 ,5.56788e-09 ,5.95928e-09 , &
      6.37419e-09 ,6.81375e-09 ,7.27917e-09 ,7.77168e-09 ,8.29256e-09 , &
      8.84317e-09 ,9.42487e-09 ,1.00391e-08 ,1.06873e-08 ,1.13710e-08 , &
      1.20919e-08 ,1.28515e-08 ,1.36514e-08 ,1.44935e-08 ,1.53796e-08 , &
      1.63114e-08 ,1.72909e-08 ,1.83201e-08 ,1.94008e-08 ,2.05354e-08 , &
      2.17258e-08 ,2.29742e-08 ,2.42830e-08 ,2.56545e-08 ,2.70910e-08 , &
      2.85950e-08 ,3.01689e-08 ,3.18155e-08 ,3.35373e-08 ,3.53372e-08 , &
      3.72177e-08 ,3.91818e-08 ,4.12325e-08 ,4.33727e-08 ,4.56056e-08 , &
      4.79342e-08 ,5.03617e-08 ,5.28915e-08 ,5.55270e-08 ,5.82715e-08 , &
      6.11286e-08 ,6.41019e-08 ,6.71951e-08 ,7.04119e-08 ,7.37560e-08 /)
      totplnk(101:150,13) = (/ &
      7.72315e-08 ,8.08424e-08 ,8.45927e-08 ,8.84866e-08 ,9.25281e-08 , &
      9.67218e-08 ,1.01072e-07 ,1.05583e-07 ,1.10260e-07 ,1.15107e-07 , &
      1.20128e-07 ,1.25330e-07 ,1.30716e-07 ,1.36291e-07 ,1.42061e-07 , &
      1.48031e-07 ,1.54206e-07 ,1.60592e-07 ,1.67192e-07 ,1.74015e-07 , &
      1.81064e-07 ,1.88345e-07 ,1.95865e-07 ,2.03628e-07 ,2.11643e-07 , &
      2.19912e-07 ,2.28443e-07 ,2.37244e-07 ,2.46318e-07 ,2.55673e-07 , &
      2.65316e-07 ,2.75252e-07 ,2.85489e-07 ,2.96033e-07 ,3.06891e-07 , &
      3.18070e-07 ,3.29576e-07 ,3.41417e-07 ,3.53600e-07 ,3.66133e-07 , &
      3.79021e-07 ,3.92274e-07 ,4.05897e-07 ,4.19899e-07 ,4.34288e-07 , &
      4.49071e-07 ,4.64255e-07 ,4.79850e-07 ,4.95863e-07 ,5.12300e-07 /)
      totplnk(151:181,13) = (/ &
      5.29172e-07 ,5.46486e-07 ,5.64250e-07 ,5.82473e-07 ,6.01164e-07 , &
      6.20329e-07 ,6.39979e-07 ,6.60122e-07 ,6.80767e-07 ,7.01922e-07 , &
      7.23596e-07 ,7.45800e-07 ,7.68539e-07 ,7.91826e-07 ,8.15669e-07 , &
      8.40076e-07 ,8.65058e-07 ,8.90623e-07 ,9.16783e-07 ,9.43544e-07 , &
      9.70917e-07 ,9.98912e-07 ,1.02754e-06 ,1.05681e-06 ,1.08673e-06 , &
      1.11731e-06 ,1.14856e-06 ,1.18050e-06 ,1.21312e-06 ,1.24645e-06 , &
      1.28049e-06 /)
      totplnk(1:50,14) = (/ &
      1.40113e-11 ,1.59358e-11 ,1.80960e-11 ,2.05171e-11 ,2.32266e-11 , &
      2.62546e-11 ,2.96335e-11 ,3.33990e-11 ,3.75896e-11 ,4.22469e-11 , &
      4.74164e-11 ,5.31466e-11 ,5.94905e-11 ,6.65054e-11 ,7.42522e-11 , &
      8.27975e-11 ,9.22122e-11 ,1.02573e-10 ,1.13961e-10 ,1.26466e-10 , &
      1.40181e-10 ,1.55206e-10 ,1.71651e-10 ,1.89630e-10 ,2.09265e-10 , &
      2.30689e-10 ,2.54040e-10 ,2.79467e-10 ,3.07128e-10 ,3.37190e-10 , &
      3.69833e-10 ,4.05243e-10 ,4.43623e-10 ,4.85183e-10 ,5.30149e-10 , &
      5.78755e-10 ,6.31255e-10 ,6.87910e-10 ,7.49002e-10 ,8.14824e-10 , &
      8.85687e-10 ,9.61914e-10 ,1.04385e-09 ,1.13186e-09 ,1.22631e-09 , &
      1.32761e-09 ,1.43617e-09 ,1.55243e-09 ,1.67686e-09 ,1.80992e-09 /)
      totplnk(51:100,14) = (/ &
      1.95212e-09 ,2.10399e-09 ,2.26607e-09 ,2.43895e-09 ,2.62321e-09 , &
      2.81949e-09 ,3.02844e-09 ,3.25073e-09 ,3.48707e-09 ,3.73820e-09 , &
      4.00490e-09 ,4.28794e-09 ,4.58819e-09 ,4.90647e-09 ,5.24371e-09 , &
      5.60081e-09 ,5.97875e-09 ,6.37854e-09 ,6.80120e-09 ,7.24782e-09 , &
      7.71950e-09 ,8.21740e-09 ,8.74271e-09 ,9.29666e-09 ,9.88054e-09 , &
      1.04956e-08 ,1.11434e-08 ,1.18251e-08 ,1.25422e-08 ,1.32964e-08 , &
      1.40890e-08 ,1.49217e-08 ,1.57961e-08 ,1.67140e-08 ,1.76771e-08 , &
      1.86870e-08 ,1.97458e-08 ,2.08553e-08 ,2.20175e-08 ,2.32342e-08 , &
      2.45077e-08 ,2.58401e-08 ,2.72334e-08 ,2.86900e-08 ,3.02122e-08 , &
      3.18021e-08 ,3.34624e-08 ,3.51954e-08 ,3.70037e-08 ,3.88899e-08 /)
      totplnk(101:150,14) = (/ &
      4.08568e-08 ,4.29068e-08 ,4.50429e-08 ,4.72678e-08 ,4.95847e-08 , &
      5.19963e-08 ,5.45058e-08 ,5.71161e-08 ,5.98309e-08 ,6.26529e-08 , &
      6.55857e-08 ,6.86327e-08 ,7.17971e-08 ,7.50829e-08 ,7.84933e-08 , &
      8.20323e-08 ,8.57035e-08 ,8.95105e-08 ,9.34579e-08 ,9.75488e-08 , &
      1.01788e-07 ,1.06179e-07 ,1.10727e-07 ,1.15434e-07 ,1.20307e-07 , &
      1.25350e-07 ,1.30566e-07 ,1.35961e-07 ,1.41539e-07 ,1.47304e-07 , &
      1.53263e-07 ,1.59419e-07 ,1.65778e-07 ,1.72345e-07 ,1.79124e-07 , &
      1.86122e-07 ,1.93343e-07 ,2.00792e-07 ,2.08476e-07 ,2.16400e-07 , &
      2.24568e-07 ,2.32988e-07 ,2.41666e-07 ,2.50605e-07 ,2.59813e-07 , &
      2.69297e-07 ,2.79060e-07 ,2.89111e-07 ,2.99455e-07 ,3.10099e-07 /)
      totplnk(151:181,14) = (/ &
      3.21049e-07 ,3.32311e-07 ,3.43893e-07 ,3.55801e-07 ,3.68041e-07 , &
      3.80621e-07 ,3.93547e-07 ,4.06826e-07 ,4.20465e-07 ,4.34473e-07 , &
      4.48856e-07 ,4.63620e-07 ,4.78774e-07 ,4.94325e-07 ,5.10280e-07 , &
      5.26648e-07 ,5.43436e-07 ,5.60652e-07 ,5.78302e-07 ,5.96397e-07 , &
      6.14943e-07 ,6.33949e-07 ,6.53421e-07 ,6.73370e-07 ,6.93803e-07 , &
      7.14731e-07 ,7.36157e-07 ,7.58095e-07 ,7.80549e-07 ,8.03533e-07 , &
      8.27050e-07 /)
      totplnk(1:50,15) = (/ &
      3.90483e-12 ,4.47999e-12 ,5.13122e-12 ,5.86739e-12 ,6.69829e-12 , &
      7.63467e-12 ,8.68833e-12 ,9.87221e-12 ,1.12005e-11 ,1.26885e-11 , &
      1.43534e-11 ,1.62134e-11 ,1.82888e-11 ,2.06012e-11 ,2.31745e-11 , &
      2.60343e-11 ,2.92087e-11 ,3.27277e-11 ,3.66242e-11 ,4.09334e-11 , &
      4.56935e-11 ,5.09455e-11 ,5.67338e-11 ,6.31057e-11 ,7.01127e-11 , &
      7.78096e-11 ,8.62554e-11 ,9.55130e-11 ,1.05651e-10 ,1.16740e-10 , &
      1.28858e-10 ,1.42089e-10 ,1.56519e-10 ,1.72243e-10 ,1.89361e-10 , &
      2.07978e-10 ,2.28209e-10 ,2.50173e-10 ,2.73999e-10 ,2.99820e-10 , &
      3.27782e-10 ,3.58034e-10 ,3.90739e-10 ,4.26067e-10 ,4.64196e-10 , &
      5.05317e-10 ,5.49631e-10 ,5.97347e-10 ,6.48689e-10 ,7.03891e-10 /)
      totplnk(51:100,15) = (/ &
      7.63201e-10 ,8.26876e-10 ,8.95192e-10 ,9.68430e-10 ,1.04690e-09 , &
      1.13091e-09 ,1.22079e-09 ,1.31689e-09 ,1.41957e-09 ,1.52922e-09 , &
      1.64623e-09 ,1.77101e-09 ,1.90401e-09 ,2.04567e-09 ,2.19647e-09 , &
      2.35690e-09 ,2.52749e-09 ,2.70875e-09 ,2.90127e-09 ,3.10560e-09 , &
      3.32238e-09 ,3.55222e-09 ,3.79578e-09 ,4.05375e-09 ,4.32682e-09 , &
      4.61574e-09 ,4.92128e-09 ,5.24420e-09 ,5.58536e-09 ,5.94558e-09 , &
      6.32575e-09 ,6.72678e-09 ,7.14964e-09 ,7.59526e-09 ,8.06470e-09 , &
      8.55897e-09 ,9.07916e-09 ,9.62638e-09 ,1.02018e-08 ,1.08066e-08 , &
      1.14420e-08 ,1.21092e-08 ,1.28097e-08 ,1.35446e-08 ,1.43155e-08 , &
      1.51237e-08 ,1.59708e-08 ,1.68581e-08 ,1.77873e-08 ,1.87599e-08 /)
      totplnk(101:150,15) = (/ &
      1.97777e-08 ,2.08423e-08 ,2.19555e-08 ,2.31190e-08 ,2.43348e-08 , &
      2.56045e-08 ,2.69302e-08 ,2.83140e-08 ,2.97578e-08 ,3.12636e-08 , &
      3.28337e-08 ,3.44702e-08 ,3.61755e-08 ,3.79516e-08 ,3.98012e-08 , &
      4.17265e-08 ,4.37300e-08 ,4.58143e-08 ,4.79819e-08 ,5.02355e-08 , &
      5.25777e-08 ,5.50114e-08 ,5.75393e-08 ,6.01644e-08 ,6.28896e-08 , &
      6.57177e-08 ,6.86521e-08 ,7.16959e-08 ,7.48520e-08 ,7.81239e-08 , &
      8.15148e-08 ,8.50282e-08 ,8.86675e-08 ,9.24362e-08 ,9.63380e-08 , &
      1.00376e-07 ,1.04555e-07 ,1.08878e-07 ,1.13349e-07 ,1.17972e-07 , &
      1.22751e-07 ,1.27690e-07 ,1.32793e-07 ,1.38064e-07 ,1.43508e-07 , &
      1.49129e-07 ,1.54931e-07 ,1.60920e-07 ,1.67099e-07 ,1.73473e-07 /)
      totplnk(151:181,15) = (/ &
      1.80046e-07 ,1.86825e-07 ,1.93812e-07 ,2.01014e-07 ,2.08436e-07 , &
      2.16082e-07 ,2.23957e-07 ,2.32067e-07 ,2.40418e-07 ,2.49013e-07 , &
      2.57860e-07 ,2.66963e-07 ,2.76328e-07 ,2.85961e-07 ,2.95868e-07 , &
      3.06053e-07 ,3.16524e-07 ,3.27286e-07 ,3.38345e-07 ,3.49707e-07 , &
      3.61379e-07 ,3.73367e-07 ,3.85676e-07 ,3.98315e-07 ,4.11287e-07 , &
      4.24602e-07 ,4.38265e-07 ,4.52283e-07 ,4.66662e-07 ,4.81410e-07 , &
      4.96535e-07 /)
      totplnk(1:50,16) = (/ &
      0.28639e-12 ,0.33349e-12 ,0.38764e-12 ,0.44977e-12 ,0.52093e-12 , &
      0.60231e-12 ,0.69522e-12 ,0.80111e-12 ,0.92163e-12 ,0.10586e-11 , &
      0.12139e-11 ,0.13899e-11 ,0.15890e-11 ,0.18138e-11 ,0.20674e-11 , &
      0.23531e-11 ,0.26744e-11 ,0.30352e-11 ,0.34401e-11 ,0.38936e-11 , &
      0.44011e-11 ,0.49681e-11 ,0.56010e-11 ,0.63065e-11 ,0.70919e-11 , &
      0.79654e-11 ,0.89357e-11 ,0.10012e-10 ,0.11205e-10 ,0.12526e-10 , &
      0.13986e-10 ,0.15600e-10 ,0.17380e-10 ,0.19342e-10 ,0.21503e-10 , &
      0.23881e-10 ,0.26494e-10 ,0.29362e-10 ,0.32509e-10 ,0.35958e-10 , &
      0.39733e-10 ,0.43863e-10 ,0.48376e-10 ,0.53303e-10 ,0.58679e-10 , &
      0.64539e-10 ,0.70920e-10 ,0.77864e-10 ,0.85413e-10 ,0.93615e-10 /)
      totplnk(51:100,16) = (/ &
      0.10252e-09 ,0.11217e-09 ,0.12264e-09 ,0.13397e-09 ,0.14624e-09 , &
      0.15950e-09 ,0.17383e-09 ,0.18930e-09 ,0.20599e-09 ,0.22399e-09 , &
      0.24339e-09 ,0.26427e-09 ,0.28674e-09 ,0.31090e-09 ,0.33686e-09 , &
      0.36474e-09 ,0.39466e-09 ,0.42676e-09 ,0.46115e-09 ,0.49800e-09 , &
      0.53744e-09 ,0.57964e-09 ,0.62476e-09 ,0.67298e-09 ,0.72448e-09 , &
      0.77945e-09 ,0.83809e-09 ,0.90062e-09 ,0.96725e-09 ,0.10382e-08 , &
      0.11138e-08 ,0.11941e-08 ,0.12796e-08 ,0.13704e-08 ,0.14669e-08 , &
      0.15694e-08 ,0.16781e-08 ,0.17934e-08 ,0.19157e-08 ,0.20453e-08 , &
      0.21825e-08 ,0.23278e-08 ,0.24815e-08 ,0.26442e-08 ,0.28161e-08 , &
      0.29978e-08 ,0.31898e-08 ,0.33925e-08 ,0.36064e-08 ,0.38321e-08 /)
      totplnk(101:150,16) = (/ &
      0.40700e-08 ,0.43209e-08 ,0.45852e-08 ,0.48636e-08 ,0.51567e-08 , &
      0.54652e-08 ,0.57897e-08 ,0.61310e-08 ,0.64897e-08 ,0.68667e-08 , &
      0.72626e-08 ,0.76784e-08 ,0.81148e-08 ,0.85727e-08 ,0.90530e-08 , &
      0.95566e-08 ,0.10084e-07 ,0.10638e-07 ,0.11217e-07 ,0.11824e-07 , &
      0.12458e-07 ,0.13123e-07 ,0.13818e-07 ,0.14545e-07 ,0.15305e-07 , &
      0.16099e-07 ,0.16928e-07 ,0.17795e-07 ,0.18699e-07 ,0.19643e-07 , &
      0.20629e-07 ,0.21656e-07 ,0.22728e-07 ,0.23845e-07 ,0.25010e-07 , &
      0.26223e-07 ,0.27487e-07 ,0.28804e-07 ,0.30174e-07 ,0.31600e-07 , &
      0.33084e-07 ,0.34628e-07 ,0.36233e-07 ,0.37902e-07 ,0.39637e-07 , &
      0.41440e-07 ,0.43313e-07 ,0.45259e-07 ,0.47279e-07 ,0.49376e-07 /)
      totplnk(151:181,16) = (/ &
      0.51552e-07 ,0.53810e-07 ,0.56153e-07 ,0.58583e-07 ,0.61102e-07 , &
      0.63713e-07 ,0.66420e-07 ,0.69224e-07 ,0.72129e-07 ,0.75138e-07 , &
      0.78254e-07 ,0.81479e-07 ,0.84818e-07 ,0.88272e-07 ,0.91846e-07 , &
      0.95543e-07 ,0.99366e-07 ,0.10332e-06 ,0.10740e-06 ,0.11163e-06 , &
      0.11599e-06 ,0.12050e-06 ,0.12515e-06 ,0.12996e-06 ,0.13493e-06 , &
      0.14005e-06 ,0.14534e-06 ,0.15080e-06 ,0.15643e-06 ,0.16224e-06 , &
      0.16823e-06 /)
      totplk16(1:50) = (/ &
      0.28481e-12 ,0.33159e-12 ,0.38535e-12 ,0.44701e-12 ,0.51763e-12 , &
      0.59836e-12 ,0.69049e-12 ,0.79549e-12 ,0.91493e-12 ,0.10506e-11 , &
      0.12045e-11 ,0.13788e-11 ,0.15758e-11 ,0.17984e-11 ,0.20493e-11 , &
      0.23317e-11 ,0.26494e-11 ,0.30060e-11 ,0.34060e-11 ,0.38539e-11 , &
      0.43548e-11 ,0.49144e-11 ,0.55387e-11 ,0.62344e-11 ,0.70086e-11 , &
      0.78692e-11 ,0.88248e-11 ,0.98846e-11 ,0.11059e-10 ,0.12358e-10 , &
      0.13794e-10 ,0.15379e-10 ,0.17128e-10 ,0.19055e-10 ,0.21176e-10 , &
      0.23508e-10 ,0.26070e-10 ,0.28881e-10 ,0.31963e-10 ,0.35339e-10 , &
      0.39034e-10 ,0.43073e-10 ,0.47484e-10 ,0.52299e-10 ,0.57548e-10 , &
      0.63267e-10 ,0.69491e-10 ,0.76261e-10 ,0.83616e-10 ,0.91603e-10 /)
      totplk16(51:100) = (/ &
      0.10027e-09 ,0.10966e-09 ,0.11983e-09 ,0.13084e-09 ,0.14275e-09 , &
      0.15562e-09 ,0.16951e-09 ,0.18451e-09 ,0.20068e-09 ,0.21810e-09 , &
      0.23686e-09 ,0.25704e-09 ,0.27875e-09 ,0.30207e-09 ,0.32712e-09 , &
      0.35400e-09 ,0.38282e-09 ,0.41372e-09 ,0.44681e-09 ,0.48223e-09 , &
      0.52013e-09 ,0.56064e-09 ,0.60392e-09 ,0.65015e-09 ,0.69948e-09 , &
      0.75209e-09 ,0.80818e-09 ,0.86794e-09 ,0.93157e-09 ,0.99929e-09 , &
      0.10713e-08 ,0.11479e-08 ,0.12293e-08 ,0.13157e-08 ,0.14074e-08 , &
      0.15047e-08 ,0.16079e-08 ,0.17172e-08 ,0.18330e-08 ,0.19557e-08 , &
      0.20855e-08 ,0.22228e-08 ,0.23680e-08 ,0.25214e-08 ,0.26835e-08 , &
      0.28546e-08 ,0.30352e-08 ,0.32257e-08 ,0.34266e-08 ,0.36384e-08 /)
      totplk16(101:150) = (/ &
      0.38615e-08 ,0.40965e-08 ,0.43438e-08 ,0.46041e-08 ,0.48779e-08 , &
      0.51658e-08 ,0.54683e-08 ,0.57862e-08 ,0.61200e-08 ,0.64705e-08 , &
      0.68382e-08 ,0.72240e-08 ,0.76285e-08 ,0.80526e-08 ,0.84969e-08 , &
      0.89624e-08 ,0.94498e-08 ,0.99599e-08 ,0.10494e-07 ,0.11052e-07 , &
      0.11636e-07 ,0.12246e-07 ,0.12884e-07 ,0.13551e-07 ,0.14246e-07 , &
      0.14973e-07 ,0.15731e-07 ,0.16522e-07 ,0.17347e-07 ,0.18207e-07 , &
      0.19103e-07 ,0.20037e-07 ,0.21011e-07 ,0.22024e-07 ,0.23079e-07 , &
      0.24177e-07 ,0.25320e-07 ,0.26508e-07 ,0.27744e-07 ,0.29029e-07 , &
      0.30365e-07 ,0.31753e-07 ,0.33194e-07 ,0.34691e-07 ,0.36246e-07 , &
      0.37859e-07 ,0.39533e-07 ,0.41270e-07 ,0.43071e-07 ,0.44939e-07 /)
      totplk16(151:181) = (/ &
      0.46875e-07 ,0.48882e-07 ,0.50961e-07 ,0.53115e-07 ,0.55345e-07 , &
      0.57655e-07 ,0.60046e-07 ,0.62520e-07 ,0.65080e-07 ,0.67728e-07 , &
      0.70466e-07 ,0.73298e-07 ,0.76225e-07 ,0.79251e-07 ,0.82377e-07 , &
      0.85606e-07 ,0.88942e-07 ,0.92386e-07 ,0.95942e-07 ,0.99612e-07 , &
      0.10340e-06 ,0.10731e-06 ,0.11134e-06 ,0.11550e-06 ,0.11979e-06 , &
      0.12421e-06 ,0.12876e-06 ,0.13346e-06 ,0.13830e-06 ,0.14328e-06 , &
      0.14841e-06 /)

      end subroutine lwavplank

!***************************************************************************

      subroutine lwavplankderiv 1
!***************************************************************************

      save
 
      totplnkderiv(1:50,  1) = (/ &
      2.22125e-08 ,2.23245e-08 ,2.24355e-08 ,2.25435e-08 ,2.26560e-08 , &
      2.27620e-08 ,2.28690e-08 ,2.29760e-08 ,2.30775e-08 ,2.31800e-08 , &
      2.32825e-08 ,2.33825e-08 ,2.34820e-08 ,2.35795e-08 ,2.36760e-08 , &
      2.37710e-08 ,2.38655e-08 ,2.39595e-08 ,2.40530e-08 ,2.41485e-08 , &
      2.42395e-08 ,2.43300e-08 ,2.44155e-08 ,2.45085e-08 ,2.45905e-08 , &
      2.46735e-08 ,2.47565e-08 ,2.48465e-08 ,2.49315e-08 ,2.50100e-08 , &
      2.50905e-08 ,2.51705e-08 ,2.52490e-08 ,2.53260e-08 ,2.54075e-08 , &
      2.54785e-08 ,2.55555e-08 ,2.56340e-08 ,2.57050e-08 ,2.57820e-08 , &
      2.58525e-08 ,2.59205e-08 ,2.59945e-08 ,2.60680e-08 ,2.61375e-08 , &
      2.61980e-08 ,2.62745e-08 ,2.63335e-08 ,2.63995e-08 ,2.64710e-08 /)
      totplnkderiv(51:100,  1) = (/ &
      2.65300e-08 ,2.66005e-08 ,2.66685e-08 ,2.67310e-08 ,2.67915e-08 , &
      2.68540e-08 ,2.69065e-08 ,2.69730e-08 ,2.70270e-08 ,2.70690e-08 , &
      2.71420e-08 ,2.71985e-08 ,2.72560e-08 ,2.73180e-08 ,2.73760e-08 , &
      2.74285e-08 ,2.74840e-08 ,2.75290e-08 ,2.75950e-08 ,2.76360e-08 , &
      2.76975e-08 ,2.77475e-08 ,2.78080e-08 ,2.78375e-08 ,2.79120e-08 , &
      2.79510e-08 ,2.79955e-08 ,2.80625e-08 ,2.80920e-08 ,2.81570e-08 , &
      2.81990e-08 ,2.82330e-08 ,2.82830e-08 ,2.83365e-08 ,2.83740e-08 , &
      2.84295e-08 ,2.84910e-08 ,2.85275e-08 ,2.85525e-08 ,2.86085e-08 , &
      2.86535e-08 ,2.86945e-08 ,2.87355e-08 ,2.87695e-08 ,2.88105e-08 , &
      2.88585e-08 ,2.88945e-08 ,2.89425e-08 ,2.89580e-08 ,2.90265e-08 /)
      totplnkderiv(101:150,  1) = (/ &
      2.90445e-08 ,2.90905e-08 ,2.91425e-08 ,2.91560e-08 ,2.91970e-08 , &
      2.91905e-08 ,2.92880e-08 ,2.92950e-08 ,2.93630e-08 ,2.93995e-08 , &
      2.94425e-08 ,2.94635e-08 ,2.94770e-08 ,2.95290e-08 ,2.95585e-08 , &
      2.95815e-08 ,2.95995e-08 ,2.96745e-08 ,2.96725e-08 ,2.97040e-08 , &
      2.97750e-08 ,2.97905e-08 ,2.98175e-08 ,2.98355e-08 ,2.98705e-08 , &
      2.99040e-08 ,2.99680e-08 ,2.99860e-08 ,3.00270e-08 ,3.00200e-08 , &
      3.00770e-08 ,3.00795e-08 ,3.01065e-08 ,3.01795e-08 ,3.01815e-08 , &
      3.02025e-08 ,3.02360e-08 ,3.02360e-08 ,3.03090e-08 ,3.03155e-08 , &
      3.03725e-08 ,3.03635e-08 ,3.04270e-08 ,3.04610e-08 ,3.04635e-08 , &
      3.04610e-08 ,3.05180e-08 ,3.05430e-08 ,3.05290e-08 ,3.05885e-08 /)
      totplnkderiv(151:181,  1) = (/ &
      3.05750e-08 ,3.05775e-08 ,3.06795e-08 ,3.07025e-08 ,3.07365e-08 , &
      3.07435e-08 ,3.07525e-08 ,3.07680e-08 ,3.08115e-08 ,3.07930e-08 , &
      3.08155e-08 ,3.08660e-08 ,3.08865e-08 ,3.08390e-08 ,3.09340e-08 , &
      3.09685e-08 ,3.09340e-08 ,3.09820e-08 ,3.10365e-08 ,3.10705e-08 , &
      3.10750e-08 ,3.10475e-08 ,3.11685e-08 ,3.11455e-08 ,3.11500e-08 , &
      3.11775e-08 ,3.11890e-08 ,3.12045e-08 ,3.12185e-08 ,3.12415e-08 , &
      3.12590e-08 /)
      totplnkderiv(1:50,  2) = (/ &
      4.91150e-08 ,4.97290e-08 ,5.03415e-08 ,5.09460e-08 ,5.15550e-08 , &
      5.21540e-08 ,5.27575e-08 ,5.33500e-08 ,5.39500e-08 ,5.45445e-08 , &
      5.51290e-08 ,5.57235e-08 ,5.62955e-08 ,5.68800e-08 ,5.74620e-08 , &
      5.80425e-08 ,5.86145e-08 ,5.91810e-08 ,5.97435e-08 ,6.03075e-08 , &
      6.08625e-08 ,6.14135e-08 ,6.19775e-08 ,6.25185e-08 ,6.30675e-08 , &
      6.36145e-08 ,6.41535e-08 ,6.46920e-08 ,6.52265e-08 ,6.57470e-08 , &
      6.62815e-08 ,6.68000e-08 ,6.73320e-08 ,6.78550e-08 ,6.83530e-08 , &
      6.88760e-08 ,6.93735e-08 ,6.98790e-08 ,7.03950e-08 ,7.08810e-08 , &
      7.13815e-08 ,7.18795e-08 ,7.23415e-08 ,7.28505e-08 ,7.33285e-08 , &
      7.38075e-08 ,7.42675e-08 ,7.47605e-08 ,7.52380e-08 ,7.57020e-08 /)
      totplnkderiv(51:100,  2) = (/ &
      7.61495e-08 ,7.65955e-08 ,7.70565e-08 ,7.75185e-08 ,7.79735e-08 , &
      7.83915e-08 ,7.88625e-08 ,7.93215e-08 ,7.97425e-08 ,8.02195e-08 , &
      8.05905e-08 ,8.10335e-08 ,8.14770e-08 ,8.19025e-08 ,8.22955e-08 , &
      8.27115e-08 ,8.31165e-08 ,8.35645e-08 ,8.39440e-08 ,8.43785e-08 , &
      8.47380e-08 ,8.51495e-08 ,8.55405e-08 ,8.59720e-08 ,8.63135e-08 , &
      8.67065e-08 ,8.70930e-08 ,8.74545e-08 ,8.78780e-08 ,8.82160e-08 , &
      8.85625e-08 ,8.89850e-08 ,8.93395e-08 ,8.97080e-08 ,9.00675e-08 , &
      9.04085e-08 ,9.07360e-08 ,9.11315e-08 ,9.13815e-08 ,9.18320e-08 , &
      9.21500e-08 ,9.24725e-08 ,9.28640e-08 ,9.31955e-08 ,9.35185e-08 , &
      9.38645e-08 ,9.41780e-08 ,9.45465e-08 ,9.48470e-08 ,9.51375e-08 /)
      totplnkderiv(101:150,  2) = (/ &
      9.55245e-08 ,9.57925e-08 ,9.61195e-08 ,9.64750e-08 ,9.68110e-08 , &
      9.71715e-08 ,9.74150e-08 ,9.77250e-08 ,9.79600e-08 ,9.82600e-08 , &
      9.85300e-08 ,9.88400e-08 ,9.91600e-08 ,9.95350e-08 ,9.97500e-08 , &
      1.00090e-07 ,1.00370e-07 ,1.00555e-07 ,1.00935e-07 ,1.01275e-07 , &
      1.01400e-07 ,1.01790e-07 ,1.01945e-07 ,1.02225e-07 ,1.02585e-07 , &
      1.02895e-07 ,1.03010e-07 ,1.03285e-07 ,1.03540e-07 ,1.03890e-07 , &
      1.04015e-07 ,1.04420e-07 ,1.04640e-07 ,1.04810e-07 ,1.05090e-07 , &
      1.05385e-07 ,1.05600e-07 ,1.05965e-07 ,1.06050e-07 ,1.06385e-07 , &
      1.06390e-07 ,1.06795e-07 ,1.06975e-07 ,1.07240e-07 ,1.07435e-07 , &
      1.07815e-07 ,1.07960e-07 ,1.08010e-07 ,1.08535e-07 ,1.08670e-07 /)
      totplnkderiv(151:181,  2) = (/ &
      1.08855e-07 ,1.09210e-07 ,1.09195e-07 ,1.09510e-07 ,1.09665e-07 , &
      1.09885e-07 ,1.10130e-07 ,1.10440e-07 ,1.10640e-07 ,1.10760e-07 , &
      1.11125e-07 ,1.11195e-07 ,1.11345e-07 ,1.11710e-07 ,1.11765e-07 , &
      1.11960e-07 ,1.12225e-07 ,1.12460e-07 ,1.12595e-07 ,1.12730e-07 , &
      1.12880e-07 ,1.13295e-07 ,1.13215e-07 ,1.13505e-07 ,1.13665e-07 , &
      1.13870e-07 ,1.14025e-07 ,1.14325e-07 ,1.14495e-07 ,1.14605e-07 , &
      1.14905e-07 /)
      totplnkderiv(1:50, 3) = (/ &
      4.27040e-08 ,4.35430e-08 ,4.43810e-08 ,4.52210e-08 ,4.60630e-08 , &
      4.69135e-08 ,4.77585e-08 ,4.86135e-08 ,4.94585e-08 ,5.03230e-08 , &
      5.11740e-08 ,5.20250e-08 ,5.28940e-08 ,5.37465e-08 ,5.46175e-08 , &
      5.54700e-08 ,5.63430e-08 ,5.72085e-08 ,5.80735e-08 ,5.89430e-08 , &
      5.98015e-08 ,6.06680e-08 ,6.15380e-08 ,6.24130e-08 ,6.32755e-08 , &
      6.41340e-08 ,6.50060e-08 ,6.58690e-08 ,6.67315e-08 ,6.76025e-08 , &
      6.84585e-08 ,6.93205e-08 ,7.01845e-08 ,7.10485e-08 ,7.19160e-08 , &
      7.27695e-08 ,7.36145e-08 ,7.44840e-08 ,7.53405e-08 ,7.61770e-08 , &
      7.70295e-08 ,7.78745e-08 ,7.87350e-08 ,7.95740e-08 ,8.04150e-08 , &
      8.12565e-08 ,8.20885e-08 ,8.29455e-08 ,8.37830e-08 ,8.46035e-08 /)
      totplnkderiv(51:100, 3) = (/ &
      8.54315e-08 ,8.62770e-08 ,8.70975e-08 ,8.79140e-08 ,8.87190e-08 , &
      8.95625e-08 ,9.03625e-08 ,9.11795e-08 ,9.19930e-08 ,9.27685e-08 , &
      9.36095e-08 ,9.43785e-08 ,9.52375e-08 ,9.59905e-08 ,9.67680e-08 , &
      9.75840e-08 ,9.83755e-08 ,9.91710e-08 ,9.99445e-08 ,1.00706e-07 , &
      1.01477e-07 ,1.02255e-07 ,1.03021e-07 ,1.03776e-07 ,1.04544e-07 , &
      1.05338e-07 ,1.06082e-07 ,1.06843e-07 ,1.07543e-07 ,1.08298e-07 , &
      1.09103e-07 ,1.09812e-07 ,1.10536e-07 ,1.11268e-07 ,1.12027e-07 , &
      1.12727e-07 ,1.13464e-07 ,1.14183e-07 ,1.15037e-07 ,1.15615e-07 , &
      1.16329e-07 ,1.17057e-07 ,1.17734e-07 ,1.18448e-07 ,1.19149e-07 , &
      1.19835e-07 ,1.20512e-07 ,1.21127e-07 ,1.21895e-07 ,1.22581e-07 /)
      totplnkderiv(101:150, 3) = (/ &
      1.23227e-07 ,1.23928e-07 ,1.24560e-07 ,1.25220e-07 ,1.25895e-07 , &
      1.26565e-07 ,1.27125e-07 ,1.27855e-07 ,1.28490e-07 ,1.29195e-07 , &
      1.29790e-07 ,1.30470e-07 ,1.31070e-07 ,1.31690e-07 ,1.32375e-07 , &
      1.32960e-07 ,1.33570e-07 ,1.34230e-07 ,1.34840e-07 ,1.35315e-07 , &
      1.35990e-07 ,1.36555e-07 ,1.37265e-07 ,1.37945e-07 ,1.38425e-07 , &
      1.38950e-07 ,1.39640e-07 ,1.40220e-07 ,1.40775e-07 ,1.41400e-07 , &
      1.42020e-07 ,1.42500e-07 ,1.43085e-07 ,1.43680e-07 ,1.44255e-07 , &
      1.44855e-07 ,1.45385e-07 ,1.45890e-07 ,1.46430e-07 ,1.46920e-07 , &
      1.47715e-07 ,1.48090e-07 ,1.48695e-07 ,1.49165e-07 ,1.49715e-07 , &
      1.50130e-07 ,1.50720e-07 ,1.51330e-07 ,1.51725e-07 ,1.52350e-07 /)
      totplnkderiv(151:181, 3) = (/ &
      1.52965e-07 ,1.53305e-07 ,1.53915e-07 ,1.54280e-07 ,1.54950e-07 , &
      1.55370e-07 ,1.55850e-07 ,1.56260e-07 ,1.56825e-07 ,1.57470e-07 , &
      1.57760e-07 ,1.58295e-07 ,1.58780e-07 ,1.59470e-07 ,1.59940e-07 , &
      1.60325e-07 ,1.60825e-07 ,1.61100e-07 ,1.61605e-07 ,1.62045e-07 , &
      1.62670e-07 ,1.63020e-07 ,1.63625e-07 ,1.63900e-07 ,1.64420e-07 , &
      1.64705e-07 ,1.65430e-07 ,1.65610e-07 ,1.66220e-07 ,1.66585e-07 , &
      1.66965e-07 /)
      totplnkderiv(1:50, 4) = (/ &
      3.32829e-08 ,3.41160e-08 ,3.49626e-08 ,3.58068e-08 ,3.66765e-08 , &
      3.75320e-08 ,3.84095e-08 ,3.92920e-08 ,4.01830e-08 ,4.10715e-08 , &
      4.19735e-08 ,4.28835e-08 ,4.37915e-08 ,4.47205e-08 ,4.56410e-08 , &
      4.65770e-08 ,4.75090e-08 ,4.84530e-08 ,4.93975e-08 ,5.03470e-08 , &
      5.13000e-08 ,5.22560e-08 ,5.32310e-08 ,5.41865e-08 ,5.51655e-08 , &
      5.61590e-08 ,5.71120e-08 ,5.81075e-08 ,5.91060e-08 ,6.00895e-08 , &
      6.10750e-08 ,6.20740e-08 ,6.30790e-08 ,6.40765e-08 ,6.50940e-08 , &
      6.60895e-08 ,6.71230e-08 ,6.81200e-08 ,6.91260e-08 ,7.01485e-08 , &
      7.11625e-08 ,7.21870e-08 ,7.32010e-08 ,7.42080e-08 ,7.52285e-08 , &
      7.62930e-08 ,7.73040e-08 ,7.83185e-08 ,7.93410e-08 ,8.03560e-08 /)
      totplnkderiv(51:100, 4) = (/ &
      8.14115e-08 ,8.24200e-08 ,8.34555e-08 ,8.45100e-08 ,8.55265e-08 , &
      8.65205e-08 ,8.75615e-08 ,8.85870e-08 ,8.96175e-08 ,9.07015e-08 , &
      9.16475e-08 ,9.27525e-08 ,9.37055e-08 ,9.47375e-08 ,9.57995e-08 , &
      9.67635e-08 ,9.77980e-08 ,9.87735e-08 ,9.98485e-08 ,1.00904e-07 , &
      1.01900e-07 ,1.02876e-07 ,1.03905e-07 ,1.04964e-07 ,1.05956e-07 , &
      1.06870e-07 ,1.07952e-07 ,1.08944e-07 ,1.10003e-07 ,1.10965e-07 , &
      1.11952e-07 ,1.12927e-07 ,1.13951e-07 ,1.14942e-07 ,1.15920e-07 , &
      1.16968e-07 ,1.17877e-07 ,1.18930e-07 ,1.19862e-07 ,1.20817e-07 , &
      1.21817e-07 ,1.22791e-07 ,1.23727e-07 ,1.24751e-07 ,1.25697e-07 , &
      1.26634e-07 ,1.27593e-07 ,1.28585e-07 ,1.29484e-07 ,1.30485e-07 /)
      totplnkderiv(101:150, 4) = (/ &
      1.31363e-07 ,1.32391e-07 ,1.33228e-07 ,1.34155e-07 ,1.35160e-07 , &
      1.36092e-07 ,1.37070e-07 ,1.37966e-07 ,1.38865e-07 ,1.39740e-07 , &
      1.40770e-07 ,1.41620e-07 ,1.42605e-07 ,1.43465e-07 ,1.44240e-07 , &
      1.45305e-07 ,1.46220e-07 ,1.47070e-07 ,1.47935e-07 ,1.48890e-07 , &
      1.49905e-07 ,1.50640e-07 ,1.51435e-07 ,1.52335e-07 ,1.53235e-07 , &
      1.54045e-07 ,1.54895e-07 ,1.55785e-07 ,1.56870e-07 ,1.57360e-07 , &
      1.58395e-07 ,1.59185e-07 ,1.60060e-07 ,1.60955e-07 ,1.61770e-07 , &
      1.62445e-07 ,1.63415e-07 ,1.64170e-07 ,1.65125e-07 ,1.65995e-07 , &
      1.66545e-07 ,1.67580e-07 ,1.68295e-07 ,1.69130e-07 ,1.69935e-07 , &
      1.70800e-07 ,1.71610e-07 ,1.72365e-07 ,1.73215e-07 ,1.73770e-07 /)
      totplnkderiv(151:181, 4) = (/ &
      1.74590e-07 ,1.75525e-07 ,1.76095e-07 ,1.77125e-07 ,1.77745e-07 , &
      1.78580e-07 ,1.79315e-07 ,1.80045e-07 ,1.80695e-07 ,1.81580e-07 , &
      1.82360e-07 ,1.83205e-07 ,1.84055e-07 ,1.84315e-07 ,1.85225e-07 , &
      1.85865e-07 ,1.86660e-07 ,1.87445e-07 ,1.88350e-07 ,1.88930e-07 , &
      1.89420e-07 ,1.90275e-07 ,1.90630e-07 ,1.91650e-07 ,1.92485e-07 , &
      1.93285e-07 ,1.93695e-07 ,1.94595e-07 ,1.94895e-07 ,1.95960e-07 , &
      1.96525e-07 /)
      totplnkderiv(1:50, 5) = (/ &
      2.41948e-08 ,2.49273e-08 ,2.56705e-08 ,2.64263e-08 ,2.71899e-08 , &
      2.79687e-08 ,2.87531e-08 ,2.95520e-08 ,3.03567e-08 ,3.11763e-08 , &
      3.20014e-08 ,3.28390e-08 ,3.36865e-08 ,3.45395e-08 ,3.54083e-08 , &
      3.62810e-08 ,3.71705e-08 ,3.80585e-08 ,3.89650e-08 ,3.98750e-08 , &
      4.07955e-08 ,4.17255e-08 ,4.26635e-08 ,4.36095e-08 ,4.45605e-08 , &
      4.55190e-08 ,4.64910e-08 ,4.74670e-08 ,4.84480e-08 ,4.94430e-08 , &
      5.04460e-08 ,5.14440e-08 ,5.24500e-08 ,5.34835e-08 ,5.44965e-08 , &
      5.55325e-08 ,5.65650e-08 ,5.76050e-08 ,5.86615e-08 ,5.97175e-08 , &
      6.07750e-08 ,6.18400e-08 ,6.29095e-08 ,6.39950e-08 ,6.50665e-08 , &
      6.61405e-08 ,6.72290e-08 ,6.82800e-08 ,6.94445e-08 ,7.05460e-08 /)
      totplnkderiv(51:100, 5) = (/ &
      7.16400e-08 ,7.27475e-08 ,7.38790e-08 ,7.49845e-08 ,7.61270e-08 , &
      7.72375e-08 ,7.83770e-08 ,7.95045e-08 ,8.06315e-08 ,8.17715e-08 , &
      8.29275e-08 ,8.40555e-08 ,8.52110e-08 ,8.63565e-08 ,8.75045e-08 , &
      8.86735e-08 ,8.98150e-08 ,9.09970e-08 ,9.21295e-08 ,9.32730e-08 , &
      9.44605e-08 ,9.56170e-08 ,9.67885e-08 ,9.79275e-08 ,9.91190e-08 , &
      1.00278e-07 ,1.01436e-07 ,1.02625e-07 ,1.03792e-07 ,1.04989e-07 , &
      1.06111e-07 ,1.07320e-07 ,1.08505e-07 ,1.09626e-07 ,1.10812e-07 , &
      1.11948e-07 ,1.13162e-07 ,1.14289e-07 ,1.15474e-07 ,1.16661e-07 , &
      1.17827e-07 ,1.19023e-07 ,1.20167e-07 ,1.21356e-07 ,1.22499e-07 , &
      1.23653e-07 ,1.24876e-07 ,1.25983e-07 ,1.27175e-07 ,1.28325e-07 /)
      totplnkderiv(101:150, 5) = (/ &
      1.29517e-07 ,1.30685e-07 ,1.31840e-07 ,1.33013e-07 ,1.34160e-07 , &
      1.35297e-07 ,1.36461e-07 ,1.37630e-07 ,1.38771e-07 ,1.39913e-07 , &
      1.41053e-07 ,1.42218e-07 ,1.43345e-07 ,1.44460e-07 ,1.45692e-07 , &
      1.46697e-07 ,1.47905e-07 ,1.49010e-07 ,1.50210e-07 ,1.51285e-07 , &
      1.52380e-07 ,1.53555e-07 ,1.54655e-07 ,1.55805e-07 ,1.56850e-07 , &
      1.58055e-07 ,1.59115e-07 ,1.60185e-07 ,1.61255e-07 ,1.62465e-07 , &
      1.63575e-07 ,1.64675e-07 ,1.65760e-07 ,1.66765e-07 ,1.67945e-07 , &
      1.69070e-07 ,1.70045e-07 ,1.71145e-07 ,1.72260e-07 ,1.73290e-07 , &
      1.74470e-07 ,1.75490e-07 ,1.76515e-07 ,1.77555e-07 ,1.78660e-07 , &
      1.79670e-07 ,1.80705e-07 ,1.81895e-07 ,1.82745e-07 ,1.83950e-07 /)
      totplnkderiv(151:181, 5) = (/ &
      1.84955e-07 ,1.85940e-07 ,1.87080e-07 ,1.88010e-07 ,1.89145e-07 , &
      1.90130e-07 ,1.91110e-07 ,1.92130e-07 ,1.93205e-07 ,1.94230e-07 , &
      1.95045e-07 ,1.96070e-07 ,1.97155e-07 ,1.98210e-07 ,1.99080e-07 , &
      2.00280e-07 ,2.01135e-07 ,2.02150e-07 ,2.03110e-07 ,2.04135e-07 , &
      2.05110e-07 ,2.06055e-07 ,2.07120e-07 ,2.08075e-07 ,2.08975e-07 , &
      2.09950e-07 ,2.10870e-07 ,2.11830e-07 ,2.12960e-07 ,2.13725e-07 , &
      2.14765e-07 /)
      totplnkderiv(1:50, 6) = (/ &
      1.36567e-08 ,1.41766e-08 ,1.47079e-08 ,1.52499e-08 ,1.58075e-08 , &
      1.63727e-08 ,1.69528e-08 ,1.75429e-08 ,1.81477e-08 ,1.87631e-08 , &
      1.93907e-08 ,2.00297e-08 ,2.06808e-08 ,2.13432e-08 ,2.20183e-08 , &
      2.27076e-08 ,2.34064e-08 ,2.41181e-08 ,2.48400e-08 ,2.55750e-08 , &
      2.63231e-08 ,2.70790e-08 ,2.78502e-08 ,2.86326e-08 ,2.94259e-08 , &
      3.02287e-08 ,3.10451e-08 ,3.18752e-08 ,3.27108e-08 ,3.35612e-08 , &
      3.44198e-08 ,3.52930e-08 ,3.61785e-08 ,3.70690e-08 ,3.79725e-08 , &
      3.88845e-08 ,3.98120e-08 ,4.07505e-08 ,4.16965e-08 ,4.26515e-08 , &
      4.36190e-08 ,4.45925e-08 ,4.55760e-08 ,4.65735e-08 ,4.75835e-08 , &
      4.85970e-08 ,4.96255e-08 ,5.06975e-08 ,5.16950e-08 ,5.27530e-08 /)
      totplnkderiv(51:100, 6) = (/ &
      5.38130e-08 ,5.48860e-08 ,5.59715e-08 ,5.70465e-08 ,5.81385e-08 , &
      5.92525e-08 ,6.03565e-08 ,6.14815e-08 ,6.26175e-08 ,6.37475e-08 , &
      6.48855e-08 ,6.60340e-08 ,6.71980e-08 ,6.83645e-08 ,6.95430e-08 , &
      7.07145e-08 ,7.19015e-08 ,7.30995e-08 ,7.43140e-08 ,7.55095e-08 , &
      7.67115e-08 ,7.79485e-08 ,7.91735e-08 ,8.03925e-08 ,8.16385e-08 , &
      8.28775e-08 ,8.41235e-08 ,8.53775e-08 ,8.66405e-08 ,8.78940e-08 , &
      8.91805e-08 ,9.04515e-08 ,9.17290e-08 ,9.30230e-08 ,9.43145e-08 , &
      9.56200e-08 ,9.69160e-08 ,9.82140e-08 ,9.95285e-08 ,1.00829e-07 , &
      1.02145e-07 ,1.03478e-07 ,1.04787e-07 ,1.06095e-07 ,1.07439e-07 , &
      1.08785e-07 ,1.10078e-07 ,1.11466e-07 ,1.12795e-07 ,1.14133e-07 /)
      totplnkderiv(101:150, 6) = (/ &
      1.15479e-07 ,1.16825e-07 ,1.18191e-07 ,1.19540e-07 ,1.20908e-07 , &
      1.22257e-07 ,1.23634e-07 ,1.24992e-07 ,1.26345e-07 ,1.27740e-07 , &
      1.29098e-07 ,1.30447e-07 ,1.31831e-07 ,1.33250e-07 ,1.34591e-07 , &
      1.36011e-07 ,1.37315e-07 ,1.38721e-07 ,1.40103e-07 ,1.41504e-07 , &
      1.42882e-07 ,1.44259e-07 ,1.45674e-07 ,1.46997e-07 ,1.48412e-07 , &
      1.49794e-07 ,1.51167e-07 ,1.52577e-07 ,1.53941e-07 ,1.55369e-07 , &
      1.56725e-07 ,1.58125e-07 ,1.59460e-07 ,1.60895e-07 ,1.62260e-07 , &
      1.63610e-07 ,1.65085e-07 ,1.66410e-07 ,1.67805e-07 ,1.69185e-07 , &
      1.70570e-07 ,1.71915e-07 ,1.73375e-07 ,1.74775e-07 ,1.76090e-07 , &
      1.77485e-07 ,1.78905e-07 ,1.80190e-07 ,1.81610e-07 ,1.82960e-07 /)
      totplnkderiv(151:181, 6) = (/ &
      1.84330e-07 ,1.85750e-07 ,1.87060e-07 ,1.88470e-07 ,1.89835e-07 , &
      1.91250e-07 ,1.92565e-07 ,1.93925e-07 ,1.95220e-07 ,1.96620e-07 , &
      1.98095e-07 ,1.99330e-07 ,2.00680e-07 ,2.02090e-07 ,2.03360e-07 , &
      2.04775e-07 ,2.06080e-07 ,2.07440e-07 ,2.08820e-07 ,2.10095e-07 , &
      2.11445e-07 ,2.12785e-07 ,2.14050e-07 ,2.15375e-07 ,2.16825e-07 , &
      2.18080e-07 ,2.19345e-07 ,2.20710e-07 ,2.21980e-07 ,2.23425e-07 , &
      2.24645e-07 /)
      totplnkderiv(1:50, 7) = (/ &
      7.22270e-09 ,7.55350e-09 ,7.89480e-09 ,8.24725e-09 ,8.60780e-09 , &
      8.98215e-09 ,9.36430e-09 ,9.76035e-09 ,1.01652e-08 ,1.05816e-08 , &
      1.10081e-08 ,1.14480e-08 ,1.18981e-08 ,1.23600e-08 ,1.28337e-08 , &
      1.33172e-08 ,1.38139e-08 ,1.43208e-08 ,1.48413e-08 ,1.53702e-08 , &
      1.59142e-08 ,1.64704e-08 ,1.70354e-08 ,1.76178e-08 ,1.82065e-08 , &
      1.88083e-08 ,1.94237e-08 ,2.00528e-08 ,2.06913e-08 ,2.13413e-08 , &
      2.20058e-08 ,2.26814e-08 ,2.33686e-08 ,2.40729e-08 ,2.47812e-08 , &
      2.55099e-08 ,2.62449e-08 ,2.69966e-08 ,2.77569e-08 ,2.85269e-08 , &
      2.93144e-08 ,3.01108e-08 ,3.09243e-08 ,3.17433e-08 ,3.25756e-08 , &
      3.34262e-08 ,3.42738e-08 ,3.51480e-08 ,3.60285e-08 ,3.69160e-08 /)
      totplnkderiv(51:100, 7) = (/ &
      3.78235e-08 ,3.87390e-08 ,3.96635e-08 ,4.06095e-08 ,4.15600e-08 , &
      4.25180e-08 ,4.34895e-08 ,4.44800e-08 ,4.54715e-08 ,4.64750e-08 , &
      4.74905e-08 ,4.85210e-08 ,4.95685e-08 ,5.06135e-08 ,5.16725e-08 , &
      5.27480e-08 ,5.38265e-08 ,5.49170e-08 ,5.60120e-08 ,5.71275e-08 , &
      5.82610e-08 ,5.93775e-08 ,6.05245e-08 ,6.17025e-08 ,6.28355e-08 , &
      6.40135e-08 ,6.52015e-08 ,6.63865e-08 ,6.75790e-08 ,6.88120e-08 , &
      7.00070e-08 ,7.12335e-08 ,7.24720e-08 ,7.37340e-08 ,7.49775e-08 , &
      7.62415e-08 ,7.75185e-08 ,7.87915e-08 ,8.00875e-08 ,8.13630e-08 , &
      8.26710e-08 ,8.39645e-08 ,8.53060e-08 ,8.66305e-08 ,8.79915e-08 , &
      8.93080e-08 ,9.06560e-08 ,9.19860e-08 ,9.33550e-08 ,9.47305e-08 /)
      totplnkderiv(101:150, 7) = (/ &
      9.61180e-08 ,9.74500e-08 ,9.88850e-08 ,1.00263e-07 ,1.01688e-07 , &
      1.03105e-07 ,1.04489e-07 ,1.05906e-07 ,1.07345e-07 ,1.08771e-07 , &
      1.10220e-07 ,1.11713e-07 ,1.13098e-07 ,1.14515e-07 ,1.16019e-07 , &
      1.17479e-07 ,1.18969e-07 ,1.20412e-07 ,1.21852e-07 ,1.23387e-07 , &
      1.24851e-07 ,1.26319e-07 ,1.27811e-07 ,1.29396e-07 ,1.30901e-07 , &
      1.32358e-07 ,1.33900e-07 ,1.35405e-07 ,1.36931e-07 ,1.38443e-07 , &
      1.39985e-07 ,1.41481e-07 ,1.43072e-07 ,1.44587e-07 ,1.46133e-07 , &
      1.47698e-07 ,1.49203e-07 ,1.50712e-07 ,1.52363e-07 ,1.53795e-07 , &
      1.55383e-07 ,1.56961e-07 ,1.58498e-07 ,1.60117e-07 ,1.61745e-07 , &
      1.63190e-07 ,1.64790e-07 ,1.66370e-07 ,1.67975e-07 ,1.69555e-07 /)
      totplnkderiv(151:181, 7) = (/ &
      1.71060e-07 ,1.72635e-07 ,1.74345e-07 ,1.75925e-07 ,1.77395e-07 , &
      1.78960e-07 ,1.80620e-07 ,1.82180e-07 ,1.83840e-07 ,1.85340e-07 , &
      1.86940e-07 ,1.88550e-07 ,1.90095e-07 ,1.91670e-07 ,1.93385e-07 , &
      1.94895e-07 ,1.96500e-07 ,1.98090e-07 ,1.99585e-07 ,2.01280e-07 , &
      2.02950e-07 ,2.04455e-07 ,2.06075e-07 ,2.07635e-07 ,2.09095e-07 , &
      2.10865e-07 ,2.12575e-07 ,2.14050e-07 ,2.15630e-07 ,2.17060e-07 , &
      2.18715e-07 /)
      totplnkderiv(1:50, 8) = (/ &
      4.26397e-09 ,4.48470e-09 ,4.71299e-09 ,4.94968e-09 ,5.19542e-09 , &
      5.44847e-09 ,5.71195e-09 ,5.98305e-09 ,6.26215e-09 ,6.55290e-09 , &
      6.85190e-09 ,7.15950e-09 ,7.47745e-09 ,7.80525e-09 ,8.14190e-09 , &
      8.48915e-09 ,8.84680e-09 ,9.21305e-09 ,9.59105e-09 ,9.98130e-09 , &
      1.03781e-08 ,1.07863e-08 ,1.12094e-08 ,1.16371e-08 ,1.20802e-08 , &
      1.25327e-08 ,1.29958e-08 ,1.34709e-08 ,1.39592e-08 ,1.44568e-08 , &
      1.49662e-08 ,1.54828e-08 ,1.60186e-08 ,1.65612e-08 ,1.71181e-08 , &
      1.76822e-08 ,1.82591e-08 ,1.88487e-08 ,1.94520e-08 ,2.00691e-08 , &
      2.06955e-08 ,2.13353e-08 ,2.19819e-08 ,2.26479e-08 ,2.33234e-08 , &
      2.40058e-08 ,2.47135e-08 ,2.54203e-08 ,2.61414e-08 ,2.68778e-08 /)
      totplnkderiv(51:100, 8) = (/ &
      2.76265e-08 ,2.83825e-08 ,2.91632e-08 ,2.99398e-08 ,3.07389e-08 , &
      3.15444e-08 ,3.23686e-08 ,3.31994e-08 ,3.40487e-08 ,3.49020e-08 , &
      3.57715e-08 ,3.66515e-08 ,3.75465e-08 ,3.84520e-08 ,3.93675e-08 , &
      4.02985e-08 ,4.12415e-08 ,4.21965e-08 ,4.31630e-08 ,4.41360e-08 , &
      4.51220e-08 ,4.61235e-08 ,4.71440e-08 ,4.81515e-08 ,4.91905e-08 , &
      5.02395e-08 ,5.12885e-08 ,5.23735e-08 ,5.34460e-08 ,5.45245e-08 , &
      5.56375e-08 ,5.67540e-08 ,5.78780e-08 ,5.90065e-08 ,6.01520e-08 , &
      6.13000e-08 ,6.24720e-08 ,6.36530e-08 ,6.48500e-08 ,6.60500e-08 , &
      6.72435e-08 ,6.84735e-08 ,6.97025e-08 ,7.09530e-08 ,7.21695e-08 , &
      7.34270e-08 ,7.47295e-08 ,7.59915e-08 ,7.72685e-08 ,7.85925e-08 /)
      totplnkderiv(101:150, 8) = (/ &
      7.98855e-08 ,8.12205e-08 ,8.25120e-08 ,8.38565e-08 ,8.52005e-08 , &
      8.65570e-08 ,8.79075e-08 ,8.92920e-08 ,9.06535e-08 ,9.20455e-08 , &
      9.34230e-08 ,9.48355e-08 ,9.62720e-08 ,9.76890e-08 ,9.90755e-08 , &
      1.00528e-07 ,1.01982e-07 ,1.03436e-07 ,1.04919e-07 ,1.06368e-07 , &
      1.07811e-07 ,1.09326e-07 ,1.10836e-07 ,1.12286e-07 ,1.13803e-07 , &
      1.15326e-07 ,1.16809e-07 ,1.18348e-07 ,1.19876e-07 ,1.21413e-07 , &
      1.22922e-07 ,1.24524e-07 ,1.26049e-07 ,1.27573e-07 ,1.29155e-07 , &
      1.30708e-07 ,1.32327e-07 ,1.33958e-07 ,1.35480e-07 ,1.37081e-07 , &
      1.38716e-07 ,1.40326e-07 ,1.41872e-07 ,1.43468e-07 ,1.45092e-07 , &
      1.46806e-07 ,1.48329e-07 ,1.49922e-07 ,1.51668e-07 ,1.53241e-07 /)
      totplnkderiv(151:181, 8) = (/ &
      1.54996e-07 ,1.56561e-07 ,1.58197e-07 ,1.59884e-07 ,1.61576e-07 , &
      1.63200e-07 ,1.64885e-07 ,1.66630e-07 ,1.68275e-07 ,1.69935e-07 , &
      1.71650e-07 ,1.73245e-07 ,1.75045e-07 ,1.76710e-07 ,1.78330e-07 , &
      1.79995e-07 ,1.81735e-07 ,1.83470e-07 ,1.85200e-07 ,1.86890e-07 , &
      1.88595e-07 ,1.90300e-07 ,1.91995e-07 ,1.93715e-07 ,1.95495e-07 , &
      1.97130e-07 ,1.98795e-07 ,2.00680e-07 ,2.02365e-07 ,2.04090e-07 , &
      2.05830e-07 /)
      totplnkderiv(1:50, 9) = (/ &
      1.85410e-09 ,1.96515e-09 ,2.08117e-09 ,2.20227e-09 ,2.32861e-09 , &
      2.46066e-09 ,2.59812e-09 ,2.74153e-09 ,2.89058e-09 ,3.04567e-09 , &
      3.20674e-09 ,3.37442e-09 ,3.54854e-09 ,3.72892e-09 ,3.91630e-09 , &
      4.11013e-09 ,4.31150e-09 ,4.52011e-09 ,4.73541e-09 ,4.95870e-09 , &
      5.18913e-09 ,5.42752e-09 ,5.67340e-09 ,5.92810e-09 ,6.18995e-09 , &
      6.46055e-09 ,6.73905e-09 ,7.02620e-09 ,7.32260e-09 ,7.62700e-09 , &
      7.94050e-09 ,8.26370e-09 ,8.59515e-09 ,8.93570e-09 ,9.28535e-09 , &
      9.64575e-09 ,1.00154e-08 ,1.03944e-08 ,1.07839e-08 ,1.11832e-08 , &
      1.15909e-08 ,1.20085e-08 ,1.24399e-08 ,1.28792e-08 ,1.33280e-08 , &
      1.37892e-08 ,1.42573e-08 ,1.47408e-08 ,1.52345e-08 ,1.57371e-08 /)
      totplnkderiv(51:100, 9) = (/ &
      1.62496e-08 ,1.67756e-08 ,1.73101e-08 ,1.78596e-08 ,1.84161e-08 , &
      1.89869e-08 ,1.95681e-08 ,2.01632e-08 ,2.07626e-08 ,2.13800e-08 , &
      2.20064e-08 ,2.26453e-08 ,2.32970e-08 ,2.39595e-08 ,2.46340e-08 , &
      2.53152e-08 ,2.60158e-08 ,2.67235e-08 ,2.74471e-08 ,2.81776e-08 , &
      2.89233e-08 ,2.96822e-08 ,3.04488e-08 ,3.12298e-08 ,3.20273e-08 , &
      3.28304e-08 ,3.36455e-08 ,3.44765e-08 ,3.53195e-08 ,3.61705e-08 , &
      3.70385e-08 ,3.79155e-08 ,3.88065e-08 ,3.97055e-08 ,4.06210e-08 , &
      4.15490e-08 ,4.24825e-08 ,4.34355e-08 ,4.43920e-08 ,4.53705e-08 , &
      4.63560e-08 ,4.73565e-08 ,4.83655e-08 ,4.93815e-08 ,5.04180e-08 , &
      5.14655e-08 ,5.25175e-08 ,5.35865e-08 ,5.46720e-08 ,5.57670e-08 /)
      totplnkderiv(101:150, 9) = (/ &
      5.68640e-08 ,5.79825e-08 ,5.91140e-08 ,6.02515e-08 ,6.13985e-08 , &
      6.25525e-08 ,6.37420e-08 ,6.49220e-08 ,6.61145e-08 ,6.73185e-08 , &
      6.85520e-08 ,6.97760e-08 ,7.10050e-08 ,7.22650e-08 ,7.35315e-08 , &
      7.48035e-08 ,7.60745e-08 ,7.73740e-08 ,7.86870e-08 ,7.99845e-08 , &
      8.13325e-08 ,8.26615e-08 ,8.40010e-08 ,8.53640e-08 ,8.67235e-08 , &
      8.80960e-08 ,8.95055e-08 ,9.08945e-08 ,9.23045e-08 ,9.37100e-08 , &
      9.51555e-08 ,9.65630e-08 ,9.80235e-08 ,9.94920e-08 ,1.00966e-07 , &
      1.02434e-07 ,1.03898e-07 ,1.05386e-07 ,1.06905e-07 ,1.08418e-07 , &
      1.09926e-07 ,1.11454e-07 ,1.13010e-07 ,1.14546e-07 ,1.16106e-07 , &
      1.17652e-07 ,1.19264e-07 ,1.20817e-07 ,1.22395e-07 ,1.24024e-07 /)
      totplnkderiv(151:181, 9) = (/ &
      1.25585e-07 ,1.27213e-07 ,1.28817e-07 ,1.30472e-07 ,1.32088e-07 , &
      1.33752e-07 ,1.35367e-07 ,1.37018e-07 ,1.38698e-07 ,1.40394e-07 , &
      1.42026e-07 ,1.43796e-07 ,1.45438e-07 ,1.47175e-07 ,1.48866e-07 , &
      1.50576e-07 ,1.52281e-07 ,1.54018e-07 ,1.55796e-07 ,1.57515e-07 , &
      1.59225e-07 ,1.60989e-07 ,1.62754e-07 ,1.64532e-07 ,1.66285e-07 , &
      1.68070e-07 ,1.69870e-07 ,1.71625e-07 ,1.73440e-07 ,1.75275e-07 , &
      1.77040e-07 /)
      totplnkderiv(1:50,10) = (/ &
      7.14917e-10 ,7.64833e-10 ,8.17460e-10 ,8.72980e-10 ,9.31380e-10 , &
      9.92940e-10 ,1.05746e-09 ,1.12555e-09 ,1.19684e-09 ,1.27162e-09 , &
      1.35001e-09 ,1.43229e-09 ,1.51815e-09 ,1.60831e-09 ,1.70271e-09 , &
      1.80088e-09 ,1.90365e-09 ,2.01075e-09 ,2.12261e-09 ,2.23924e-09 , &
      2.36057e-09 ,2.48681e-09 ,2.61814e-09 ,2.75506e-09 ,2.89692e-09 , &
      3.04423e-09 ,3.19758e-09 ,3.35681e-09 ,3.52113e-09 ,3.69280e-09 , &
      3.86919e-09 ,4.05205e-09 ,4.24184e-09 ,4.43877e-09 ,4.64134e-09 , &
      4.85088e-09 ,5.06670e-09 ,5.29143e-09 ,5.52205e-09 ,5.75980e-09 , &
      6.00550e-09 ,6.25840e-09 ,6.51855e-09 ,6.78800e-09 ,7.06435e-09 , &
      7.34935e-09 ,7.64220e-09 ,7.94470e-09 ,8.25340e-09 ,8.57030e-09 /)
      totplnkderiv(51:100,10) = (/ &
      8.89680e-09 ,9.23255e-09 ,9.57770e-09 ,9.93045e-09 ,1.02932e-08 , &
      1.06649e-08 ,1.10443e-08 ,1.14348e-08 ,1.18350e-08 ,1.22463e-08 , &
      1.26679e-08 ,1.30949e-08 ,1.35358e-08 ,1.39824e-08 ,1.44425e-08 , &
      1.49126e-08 ,1.53884e-08 ,1.58826e-08 ,1.63808e-08 ,1.68974e-08 , &
      1.74159e-08 ,1.79447e-08 ,1.84886e-08 ,1.90456e-08 ,1.96124e-08 , &
      2.01863e-08 ,2.07737e-08 ,2.13720e-08 ,2.19837e-08 ,2.26044e-08 , &
      2.32396e-08 ,2.38856e-08 ,2.45344e-08 ,2.52055e-08 ,2.58791e-08 , &
      2.65706e-08 ,2.72758e-08 ,2.79852e-08 ,2.87201e-08 ,2.94518e-08 , &
      3.02063e-08 ,3.09651e-08 ,3.17357e-08 ,3.25235e-08 ,3.33215e-08 , &
      3.41285e-08 ,3.49485e-08 ,3.57925e-08 ,3.66330e-08 ,3.74765e-08 /)
      totplnkderiv(101:150,10) = (/ &
      3.83675e-08 ,3.92390e-08 ,4.01330e-08 ,4.10340e-08 ,4.19585e-08 , &
      4.28815e-08 ,4.38210e-08 ,4.47770e-08 ,4.57575e-08 ,4.67325e-08 , &
      4.77170e-08 ,4.87205e-08 ,4.97410e-08 ,5.07620e-08 ,5.18180e-08 , &
      5.28540e-08 ,5.39260e-08 ,5.50035e-08 ,5.60885e-08 ,5.71900e-08 , &
      5.82940e-08 ,5.94380e-08 ,6.05690e-08 ,6.17185e-08 ,6.28860e-08 , &
      6.40670e-08 ,6.52300e-08 ,6.64225e-08 ,6.76485e-08 ,6.88715e-08 , &
      7.00750e-08 ,7.13760e-08 ,7.25910e-08 ,7.38860e-08 ,7.51290e-08 , &
      7.64420e-08 ,7.77550e-08 ,7.90725e-08 ,8.03825e-08 ,8.17330e-08 , &
      8.30810e-08 ,8.44330e-08 ,8.57720e-08 ,8.72115e-08 ,8.85800e-08 , &
      8.99945e-08 ,9.13905e-08 ,9.28345e-08 ,9.42665e-08 ,9.56765e-08 /)
      totplnkderiv(151:181,10) = (/ &
      9.72000e-08 ,9.86780e-08 ,1.00105e-07 ,1.01616e-07 ,1.03078e-07 , &
      1.04610e-07 ,1.06154e-07 ,1.07639e-07 ,1.09242e-07 ,1.10804e-07 , &
      1.12384e-07 ,1.13871e-07 ,1.15478e-07 ,1.17066e-07 ,1.18703e-07 , &
      1.20294e-07 ,1.21930e-07 ,1.23543e-07 ,1.25169e-07 ,1.26806e-07 , &
      1.28503e-07 ,1.30233e-07 ,1.31834e-07 ,1.33596e-07 ,1.35283e-07 , &
      1.36947e-07 ,1.38594e-07 ,1.40362e-07 ,1.42131e-07 ,1.43823e-07 , &
      1.45592e-07 /)
      totplnkderiv(1:50,11) = (/ &
      2.25919e-10 ,2.43810e-10 ,2.62866e-10 ,2.83125e-10 ,3.04676e-10 , &
      3.27536e-10 ,3.51796e-10 ,3.77498e-10 ,4.04714e-10 ,4.33528e-10 , &
      4.64000e-10 ,4.96185e-10 ,5.30165e-10 ,5.65999e-10 ,6.03749e-10 , &
      6.43579e-10 ,6.85479e-10 ,7.29517e-10 ,7.75810e-10 ,8.24440e-10 , &
      8.75520e-10 ,9.29065e-10 ,9.85175e-10 ,1.04405e-09 ,1.10562e-09 , &
      1.17005e-09 ,1.23742e-09 ,1.30780e-09 ,1.38141e-09 ,1.45809e-09 , &
      1.53825e-09 ,1.62177e-09 ,1.70884e-09 ,1.79942e-09 ,1.89390e-09 , &
      1.99205e-09 ,2.09429e-09 ,2.20030e-09 ,2.31077e-09 ,2.42510e-09 , &
      2.54410e-09 ,2.66754e-09 ,2.79529e-09 ,2.92777e-09 ,3.06498e-09 , &
      3.20691e-09 ,3.35450e-09 ,3.50653e-09 ,3.66427e-09 ,3.82723e-09 /)
      totplnkderiv(51:100,11) = (/ &
      3.99549e-09 ,4.16911e-09 ,4.34892e-09 ,4.53415e-09 ,4.72504e-09 , &
      4.92197e-09 ,5.12525e-09 ,5.33485e-09 ,5.55085e-09 ,5.77275e-09 , &
      6.00105e-09 ,6.23650e-09 ,6.47855e-09 ,6.72735e-09 ,6.98325e-09 , &
      7.24695e-09 ,7.51730e-09 ,7.79480e-09 ,8.07975e-09 ,8.37170e-09 , &
      8.67195e-09 ,8.98050e-09 ,9.29575e-09 ,9.61950e-09 ,9.95150e-09 , &
      1.02912e-08 ,1.06397e-08 ,1.09964e-08 ,1.13611e-08 ,1.17348e-08 , &
      1.21158e-08 ,1.25072e-08 ,1.29079e-08 ,1.33159e-08 ,1.37342e-08 , &
      1.41599e-08 ,1.45966e-08 ,1.50438e-08 ,1.54964e-08 ,1.59605e-08 , &
      1.64337e-08 ,1.69189e-08 ,1.74134e-08 ,1.79136e-08 ,1.84272e-08 , &
      1.89502e-08 ,1.94845e-08 ,2.00248e-08 ,2.05788e-08 ,2.11455e-08 /)
      totplnkderiv(101:150,11) = (/ &
      2.17159e-08 ,2.23036e-08 ,2.28983e-08 ,2.35033e-08 ,2.41204e-08 , &
      2.47485e-08 ,2.53860e-08 ,2.60331e-08 ,2.66891e-08 ,2.73644e-08 , &
      2.80440e-08 ,2.87361e-08 ,2.94412e-08 ,3.01560e-08 ,3.08805e-08 , &
      3.16195e-08 ,3.23690e-08 ,3.31285e-08 ,3.39015e-08 ,3.46820e-08 , &
      3.54770e-08 ,3.62805e-08 ,3.70960e-08 ,3.79295e-08 ,3.87715e-08 , &
      3.96185e-08 ,4.04860e-08 ,4.13600e-08 ,4.22500e-08 ,4.31490e-08 , &
      4.40610e-08 ,4.49810e-08 ,4.59205e-08 ,4.68650e-08 ,4.78260e-08 , &
      4.87970e-08 ,4.97790e-08 ,5.07645e-08 ,5.17730e-08 ,5.27960e-08 , &
      5.38285e-08 ,5.48650e-08 ,5.59205e-08 ,5.69960e-08 ,5.80690e-08 , &
      5.91570e-08 ,6.02640e-08 ,6.13750e-08 ,6.25015e-08 ,6.36475e-08 /)
      totplnkderiv(151:181,11) = (/ &
      6.47950e-08 ,6.59510e-08 ,6.71345e-08 ,6.83175e-08 ,6.95250e-08 , &
      7.07325e-08 ,7.19490e-08 ,7.31880e-08 ,7.44315e-08 ,7.56880e-08 , &
      7.69500e-08 ,7.82495e-08 ,7.95330e-08 ,8.08450e-08 ,8.21535e-08 , &
      8.34860e-08 ,8.48330e-08 ,8.61795e-08 ,8.75480e-08 ,8.89235e-08 , &
      9.03060e-08 ,9.17045e-08 ,9.31140e-08 ,9.45240e-08 ,9.59720e-08 , &
      9.74140e-08 ,9.88825e-08 ,1.00347e-07 ,1.01825e-07 ,1.03305e-07 , &
      1.04826e-07 /)
      totplnkderiv(1:50,12) = (/ &
      2.91689e-11 ,3.20300e-11 ,3.51272e-11 ,3.84803e-11 ,4.21014e-11 , &
      4.60107e-11 ,5.02265e-11 ,5.47685e-11 ,5.96564e-11 ,6.49111e-11 , &
      7.05522e-11 ,7.66060e-11 ,8.30974e-11 ,9.00441e-11 ,9.74820e-11 , &
      1.05435e-10 ,1.13925e-10 ,1.22981e-10 ,1.32640e-10 ,1.42933e-10 , &
      1.53882e-10 ,1.65527e-10 ,1.77903e-10 ,1.91054e-10 ,2.05001e-10 , &
      2.19779e-10 ,2.35448e-10 ,2.52042e-10 ,2.69565e-10 ,2.88128e-10 , &
      3.07714e-10 ,3.28370e-10 ,3.50238e-10 ,3.73235e-10 ,3.97433e-10 , &
      4.22964e-10 ,4.49822e-10 ,4.78042e-10 ,5.07721e-10 ,5.38915e-10 , &
      5.71610e-10 ,6.05916e-10 ,6.41896e-10 ,6.79600e-10 ,7.19110e-10 , &
      7.60455e-10 ,8.03625e-10 ,8.48870e-10 ,8.96080e-10 ,9.45490e-10 /)
      totplnkderiv(51:100,12) = (/ &
      9.96930e-10 ,1.05071e-09 ,1.10679e-09 ,1.16521e-09 ,1.22617e-09 , &
      1.28945e-09 ,1.35554e-09 ,1.42427e-09 ,1.49574e-09 ,1.56984e-09 , &
      1.64695e-09 ,1.72715e-09 ,1.81034e-09 ,1.89656e-09 ,1.98613e-09 , &
      2.07898e-09 ,2.17515e-09 ,2.27498e-09 ,2.37826e-09 ,2.48517e-09 , &
      2.59566e-09 ,2.71004e-09 ,2.82834e-09 ,2.95078e-09 ,3.07686e-09 , &
      3.20739e-09 ,3.34232e-09 ,3.48162e-09 ,3.62515e-09 ,3.77337e-09 , &
      3.92614e-09 ,4.08317e-09 ,4.24567e-09 ,4.41272e-09 ,4.58524e-09 , &
      4.76245e-09 ,4.94450e-09 ,5.13235e-09 ,5.32535e-09 ,5.52415e-09 , &
      5.72770e-09 ,5.93815e-09 ,6.15315e-09 ,6.37525e-09 ,6.60175e-09 , &
      6.83485e-09 ,7.07490e-09 ,7.32060e-09 ,7.57225e-09 ,7.83035e-09 /)
      totplnkderiv(101:150,12) = (/ &
      8.09580e-09 ,8.36620e-09 ,8.64410e-09 ,8.93110e-09 ,9.22170e-09 , &
      9.52055e-09 ,9.82595e-09 ,1.01399e-08 ,1.04613e-08 ,1.07878e-08 , &
      1.11223e-08 ,1.14667e-08 ,1.18152e-08 ,1.21748e-08 ,1.25410e-08 , &
      1.29147e-08 ,1.32948e-08 ,1.36858e-08 ,1.40827e-08 ,1.44908e-08 , &
      1.49040e-08 ,1.53284e-08 ,1.57610e-08 ,1.61995e-08 ,1.66483e-08 , &
      1.71068e-08 ,1.75714e-08 ,1.80464e-08 ,1.85337e-08 ,1.90249e-08 , &
      1.95309e-08 ,2.00407e-08 ,2.05333e-08 ,2.10929e-08 ,2.16346e-08 , &
      2.21829e-08 ,2.27402e-08 ,2.33112e-08 ,2.38922e-08 ,2.44802e-08 , &
      2.50762e-08 ,2.56896e-08 ,2.63057e-08 ,2.69318e-08 ,2.75705e-08 , &
      2.82216e-08 ,2.88787e-08 ,2.95505e-08 ,3.02335e-08 ,3.09215e-08 /)
      totplnkderiv(151:181,12) = (/ &
      3.16235e-08 ,3.23350e-08 ,3.30590e-08 ,3.37960e-08 ,3.45395e-08 , &
      3.52955e-08 ,3.60615e-08 ,3.68350e-08 ,3.76265e-08 ,3.84255e-08 , &
      3.92400e-08 ,4.00485e-08 ,4.08940e-08 ,4.17310e-08 ,4.25860e-08 , &
      4.34585e-08 ,4.43270e-08 ,4.52220e-08 ,4.61225e-08 ,4.70345e-08 , &
      4.79560e-08 ,4.89000e-08 ,4.98445e-08 ,5.07985e-08 ,5.17705e-08 , &
      5.27575e-08 ,5.37420e-08 ,5.47495e-08 ,5.57725e-08 ,5.68105e-08 , &
      5.78395e-08 /)
      totplnkderiv(1:50,13) = (/ &
      5.47482e-12 ,6.09637e-12 ,6.77874e-12 ,7.52703e-12 ,8.34784e-12 , &
      9.24486e-12 ,1.02246e-11 ,1.12956e-11 ,1.24615e-11 ,1.37321e-11 , &
      1.51131e-11 ,1.66129e-11 ,1.82416e-11 ,2.00072e-11 ,2.19187e-11 , &
      2.39828e-11 ,2.62171e-11 ,2.86290e-11 ,3.12283e-11 ,3.40276e-11 , &
      3.70433e-11 ,4.02847e-11 ,4.37738e-11 ,4.75070e-11 ,5.15119e-11 , &
      5.58120e-11 ,6.04059e-11 ,6.53208e-11 ,7.05774e-11 ,7.61935e-11 , &
      8.21832e-11 ,8.85570e-11 ,9.53575e-11 ,1.02592e-10 ,1.10298e-10 , &
      1.18470e-10 ,1.27161e-10 ,1.36381e-10 ,1.46161e-10 ,1.56529e-10 , &
      1.67521e-10 ,1.79142e-10 ,1.91423e-10 ,2.04405e-10 ,2.18123e-10 , &
      2.32608e-10 ,2.47889e-10 ,2.63994e-10 ,2.80978e-10 ,2.98843e-10 /)
      totplnkderiv(51:100,13) = (/ &
      3.17659e-10 ,3.37423e-10 ,3.58206e-10 ,3.80090e-10 ,4.02996e-10 , &
      4.27065e-10 ,4.52298e-10 ,4.78781e-10 ,5.06493e-10 ,5.35576e-10 , &
      5.65942e-10 ,5.97761e-10 ,6.31007e-10 ,6.65740e-10 ,7.02095e-10 , &
      7.39945e-10 ,7.79575e-10 ,8.20845e-10 ,8.63870e-10 ,9.08680e-10 , &
      9.55385e-10 ,1.00416e-09 ,1.05464e-09 ,1.10737e-09 ,1.16225e-09 , &
      1.21918e-09 ,1.27827e-09 ,1.33988e-09 ,1.40370e-09 ,1.46994e-09 , &
      1.53850e-09 ,1.60993e-09 ,1.68382e-09 ,1.76039e-09 ,1.83997e-09 , &
      1.92182e-09 ,2.00686e-09 ,2.09511e-09 ,2.18620e-09 ,2.28034e-09 , &
      2.37753e-09 ,2.47805e-09 ,2.58193e-09 ,2.68935e-09 ,2.80064e-09 , &
      2.91493e-09 ,3.03271e-09 ,3.15474e-09 ,3.27987e-09 ,3.40936e-09 /)
      totplnkderiv(101:150,13) = (/ &
      3.54277e-09 ,3.68019e-09 ,3.82173e-09 ,3.96703e-09 ,4.11746e-09 , &
      4.27104e-09 ,4.43020e-09 ,4.59395e-09 ,4.76060e-09 ,4.93430e-09 , &
      5.11085e-09 ,5.29280e-09 ,5.48055e-09 ,5.67300e-09 ,5.86950e-09 , &
      6.07160e-09 ,6.28015e-09 ,6.49295e-09 ,6.71195e-09 ,6.93455e-09 , &
      7.16470e-09 ,7.39985e-09 ,7.64120e-09 ,7.88885e-09 ,8.13910e-09 , &
      8.39930e-09 ,8.66535e-09 ,8.93600e-09 ,9.21445e-09 ,9.49865e-09 , &
      9.78845e-09 ,1.00856e-08 ,1.04361e-08 ,1.07018e-08 ,1.10164e-08 , &
      1.13438e-08 ,1.16748e-08 ,1.20133e-08 ,1.23575e-08 ,1.27117e-08 , &
      1.30708e-08 ,1.34383e-08 ,1.38138e-08 ,1.41985e-08 ,1.45859e-08 , &
      1.49846e-08 ,1.53879e-08 ,1.58042e-08 ,1.62239e-08 ,1.66529e-08 /)
      totplnkderiv(151:181,13) = (/ &
      1.70954e-08 ,1.75422e-08 ,1.79943e-08 ,1.84537e-08 ,1.89280e-08 , &
      1.94078e-08 ,1.98997e-08 ,2.03948e-08 ,2.08956e-08 ,2.14169e-08 , &
      2.19330e-08 ,2.24773e-08 ,2.30085e-08 ,2.35676e-08 ,2.41237e-08 , &
      2.46919e-08 ,2.52720e-08 ,2.58575e-08 ,2.64578e-08 ,2.70675e-08 , &
      2.76878e-08 ,2.83034e-08 ,2.89430e-08 ,2.95980e-08 ,3.02480e-08 , &
      3.09105e-08 ,3.15980e-08 ,3.22865e-08 ,3.29755e-08 ,3.36775e-08 , &
      3.43990e-08 /)
      totplnkderiv(1:50,14) = (/ &
      1.81489e-12 ,2.03846e-12 ,2.28659e-12 ,2.56071e-12 ,2.86352e-12 , &
      3.19789e-12 ,3.56668e-12 ,3.97211e-12 ,4.41711e-12 ,4.90616e-12 , &
      5.44153e-12 ,6.02790e-12 ,6.67001e-12 ,7.37018e-12 ,8.13433e-12 , &
      8.96872e-12 ,9.87526e-12 ,1.08601e-11 ,1.19328e-11 ,1.30938e-11 , &
      1.43548e-11 ,1.57182e-11 ,1.71916e-11 ,1.87875e-11 ,2.05091e-11 , &
      2.23652e-11 ,2.43627e-11 ,2.65190e-11 ,2.88354e-11 ,3.13224e-11 , &
      3.39926e-11 ,3.68664e-11 ,3.99372e-11 ,4.32309e-11 ,4.67496e-11 , &
      5.05182e-11 ,5.45350e-11 ,5.88268e-11 ,6.34126e-11 ,6.82878e-11 , &
      7.34973e-11 ,7.90201e-11 ,8.49075e-11 ,9.11725e-11 ,9.78235e-11 , &
      1.04856e-10 ,1.12342e-10 ,1.20278e-10 ,1.28680e-10 ,1.37560e-10 /)
      totplnkderiv(51:100,14) = (/ &
      1.46953e-10 ,1.56900e-10 ,1.67401e-10 ,1.78498e-10 ,1.90161e-10 , &
      2.02523e-10 ,2.15535e-10 ,2.29239e-10 ,2.43665e-10 ,2.58799e-10 , &
      2.74767e-10 ,2.91522e-10 ,3.09141e-10 ,3.27625e-10 ,3.47011e-10 , &
      3.67419e-10 ,3.88720e-10 ,4.11066e-10 ,4.34522e-10 ,4.59002e-10 , &
      4.84657e-10 ,5.11391e-10 ,5.39524e-10 ,5.68709e-10 ,5.99240e-10 , &
      6.31295e-10 ,6.64520e-10 ,6.99200e-10 ,7.35525e-10 ,7.73135e-10 , &
      8.12440e-10 ,8.53275e-10 ,8.95930e-10 ,9.40165e-10 ,9.86260e-10 , &
      1.03423e-09 ,1.08385e-09 ,1.13567e-09 ,1.18916e-09 ,1.24469e-09 , &
      1.30262e-09 ,1.36268e-09 ,1.42479e-09 ,1.48904e-09 ,1.55557e-09 , &
      1.62478e-09 ,1.69642e-09 ,1.77023e-09 ,1.84696e-09 ,1.92646e-09 /)
      totplnkderiv(101:150,14) = (/ &
      2.00831e-09 ,2.09299e-09 ,2.18007e-09 ,2.27093e-09 ,2.36398e-09 , &
      2.46020e-09 ,2.55985e-09 ,2.66230e-09 ,2.76795e-09 ,2.87667e-09 , &
      2.98971e-09 ,3.10539e-09 ,3.22462e-09 ,3.34779e-09 ,3.47403e-09 , &
      3.60419e-09 ,3.73905e-09 ,3.87658e-09 ,4.01844e-09 ,4.16535e-09 , &
      4.31470e-09 ,4.46880e-09 ,4.62765e-09 ,4.78970e-09 ,4.95735e-09 , &
      5.12890e-09 ,5.30430e-09 ,5.48595e-09 ,5.67010e-09 ,5.86145e-09 , &
      6.05740e-09 ,6.25725e-09 ,6.46205e-09 ,6.67130e-09 ,6.88885e-09 , &
      7.10845e-09 ,7.33450e-09 ,7.56700e-09 ,7.80440e-09 ,8.04465e-09 , &
      8.29340e-09 ,8.54820e-09 ,8.80790e-09 ,9.07195e-09 ,9.34605e-09 , &
      9.62005e-09 ,9.90685e-09 ,1.01939e-08 ,1.04938e-08 ,1.07957e-08 /)
      totplnkderiv(151:181,14) = (/ &
      1.11059e-08 ,1.14208e-08 ,1.17447e-08 ,1.20717e-08 ,1.24088e-08 , &
      1.27490e-08 ,1.31020e-08 ,1.34601e-08 ,1.38231e-08 ,1.41966e-08 , &
      1.45767e-08 ,1.49570e-08 ,1.53503e-08 ,1.57496e-08 ,1.61663e-08 , &
      1.65784e-08 ,1.70027e-08 ,1.74290e-08 ,1.78730e-08 ,1.83235e-08 , &
      1.87810e-08 ,1.92418e-08 ,1.97121e-08 ,2.01899e-08 ,2.05787e-08 , &
      2.11784e-08 ,2.16824e-08 ,2.21931e-08 ,2.27235e-08 ,2.32526e-08 , &
      2.37850e-08 /)
      totplnkderiv(1:50,15) = (/ &
      5.39905e-13 ,6.11835e-13 ,6.92224e-13 ,7.81886e-13 ,8.81851e-13 , &
      9.93072e-13 ,1.11659e-12 ,1.25364e-12 ,1.40562e-12 ,1.57359e-12 , &
      1.75937e-12 ,1.96449e-12 ,2.19026e-12 ,2.43892e-12 ,2.71249e-12 , &
      3.01233e-12 ,3.34163e-12 ,3.70251e-12 ,4.09728e-12 ,4.52885e-12 , &
      4.99939e-12 ,5.51242e-12 ,6.07256e-12 ,6.68167e-12 ,7.34274e-12 , &
      8.06178e-12 ,8.84185e-12 ,9.68684e-12 ,1.06020e-11 ,1.15909e-11 , &
      1.26610e-11 ,1.38158e-11 ,1.50620e-11 ,1.64047e-11 ,1.78508e-11 , &
      1.94055e-11 ,2.10805e-11 ,2.28753e-11 ,2.48000e-11 ,2.68699e-11 , &
      2.90824e-11 ,3.14526e-11 ,3.39882e-11 ,3.67020e-11 ,3.95914e-11 , &
      4.26870e-11 ,4.59824e-11 ,4.94926e-11 ,5.32302e-11 ,5.72117e-11 /)
      totplnkderiv(51:100,15) = (/ &
      6.14475e-11 ,6.59483e-11 ,7.07393e-11 ,7.57999e-11 ,8.11980e-11 , &
      8.68920e-11 ,9.29390e-11 ,9.93335e-11 ,1.06101e-10 ,1.13263e-10 , &
      1.20827e-10 ,1.28819e-10 ,1.37255e-10 ,1.46163e-10 ,1.55547e-10 , &
      1.65428e-10 ,1.75837e-10 ,1.86816e-10 ,1.98337e-10 ,2.10476e-10 , &
      2.23218e-10 ,2.36600e-10 ,2.50651e-10 ,2.65425e-10 ,2.80895e-10 , &
      2.97102e-10 ,3.14100e-10 ,3.31919e-10 ,3.50568e-10 ,3.70064e-10 , &
      3.90464e-10 ,4.11813e-10 ,4.34111e-10 ,4.57421e-10 ,4.81717e-10 , &
      5.07039e-10 ,5.33569e-10 ,5.61137e-10 ,5.89975e-10 ,6.19980e-10 , &
      6.51170e-10 ,6.83650e-10 ,7.17520e-10 ,7.52735e-10 ,7.89390e-10 , &
      8.27355e-10 ,8.66945e-10 ,9.08020e-10 ,9.50665e-10 ,9.95055e-10 /)
      totplnkderiv(101:150,15) = (/ &
      1.04101e-09 ,1.08864e-09 ,1.13823e-09 ,1.18923e-09 ,1.24257e-09 , &
      1.29741e-09 ,1.35442e-09 ,1.41347e-09 ,1.47447e-09 ,1.53767e-09 , &
      1.60322e-09 ,1.67063e-09 ,1.74033e-09 ,1.81256e-09 ,1.88704e-09 , &
      1.96404e-09 ,2.04329e-09 ,2.12531e-09 ,2.21032e-09 ,2.29757e-09 , &
      2.38739e-09 ,2.48075e-09 ,2.57628e-09 ,2.67481e-09 ,2.77627e-09 , &
      2.88100e-09 ,2.98862e-09 ,3.09946e-09 ,3.21390e-09 ,3.33105e-09 , &
      3.45185e-09 ,3.57599e-09 ,3.70370e-09 ,3.83512e-09 ,3.96909e-09 , &
      4.10872e-09 ,4.25070e-09 ,4.39605e-09 ,4.54670e-09 ,4.70015e-09 , &
      4.85850e-09 ,5.02050e-09 ,5.18655e-09 ,5.35815e-09 ,5.53180e-09 , &
      5.71225e-09 ,5.89495e-09 ,6.08260e-09 ,6.27485e-09 ,6.47345e-09 /)
      totplnkderiv(151:181,15) = (/ &
      6.67520e-09 ,6.88310e-09 ,7.09400e-09 ,7.31140e-09 ,7.53350e-09 , &
      7.76040e-09 ,7.99215e-09 ,8.22850e-09 ,8.47235e-09 ,8.71975e-09 , &
      8.97360e-09 ,9.23365e-09 ,9.49950e-09 ,9.76965e-09 ,1.00441e-08 , &
      1.03270e-08 ,1.06158e-08 ,1.09112e-08 ,1.12111e-08 ,1.15172e-08 , &
      1.18263e-08 ,1.21475e-08 ,1.24735e-08 ,1.28027e-08 ,1.32023e-08 , &
      1.34877e-08 ,1.38399e-08 ,1.42000e-08 ,1.45625e-08 ,1.49339e-08 , &
      1.53156e-08 /)
      totplnkderiv(1:50,16) = (/ &
      4.38799e-14 ,5.04835e-14 ,5.79773e-14 ,6.64627e-14 ,7.60706e-14 , &
      8.69213e-14 ,9.91554e-14 ,1.12932e-13 ,1.28419e-13 ,1.45809e-13 , &
      1.65298e-13 ,1.87109e-13 ,2.11503e-13 ,2.38724e-13 ,2.69058e-13 , &
      3.02878e-13 ,3.40423e-13 ,3.82128e-13 ,4.28390e-13 ,4.79625e-13 , &
      5.36292e-13 ,5.98933e-13 ,6.68066e-13 ,7.44216e-13 ,8.28159e-13 , &
      9.20431e-13 ,1.02180e-12 ,1.13307e-12 ,1.25504e-12 ,1.38863e-12 , &
      1.53481e-12 ,1.69447e-12 ,1.86896e-12 ,2.05903e-12 ,2.26637e-12 , &
      2.49193e-12 ,2.73736e-12 ,3.00416e-12 ,3.29393e-12 ,3.60781e-12 , &
      3.94805e-12 ,4.31675e-12 ,4.71543e-12 ,5.14627e-12 ,5.61226e-12 , &
      6.11456e-12 ,6.65585e-12 ,7.23969e-12 ,7.86811e-12 ,8.54456e-12 /)
      totplnkderiv(51:100,16) = (/ &
      9.27075e-12 ,1.00516e-11 ,1.08898e-11 ,1.17884e-11 ,1.27514e-11 , &
      1.37839e-11 ,1.48893e-11 ,1.60716e-11 ,1.73333e-11 ,1.86849e-11 , &
      2.01237e-11 ,2.16610e-11 ,2.33001e-11 ,2.50440e-11 ,2.69035e-11 , &
      2.88827e-11 ,3.09881e-11 ,3.32234e-11 ,3.55981e-11 ,3.81193e-11 , &
      4.07946e-11 ,4.36376e-11 ,4.66485e-11 ,4.98318e-11 ,5.32080e-11 , &
      5.67754e-11 ,6.05524e-11 ,6.45450e-11 ,6.87639e-11 ,7.32160e-11 , &
      7.79170e-11 ,8.28780e-11 ,8.81045e-11 ,9.36200e-11 ,9.94280e-11 , &
      1.05545e-10 ,1.11982e-10 ,1.18752e-10 ,1.25866e-10 ,1.33350e-10 , &
      1.41210e-10 ,1.49469e-10 ,1.58143e-10 ,1.67233e-10 ,1.76760e-10 , &
      1.86758e-10 ,1.97236e-10 ,2.08227e-10 ,2.19723e-10 ,2.31737e-10 /)
      totplnkderiv(101:150,16) = (/ &
      2.44329e-10 ,2.57503e-10 ,2.71267e-10 ,2.85647e-10 ,3.00706e-10 , &
      3.16391e-10 ,3.32807e-10 ,3.49887e-10 ,3.67748e-10 ,3.86369e-10 , &
      4.05746e-10 ,4.25984e-10 ,4.47060e-10 ,4.68993e-10 ,4.91860e-10 , &
      5.15601e-10 ,5.40365e-10 ,5.66085e-10 ,5.92855e-10 ,6.20640e-10 , &
      6.49605e-10 ,6.79585e-10 ,7.10710e-10 ,7.43145e-10 ,7.76805e-10 , &
      8.11625e-10 ,8.47800e-10 ,8.85300e-10 ,9.24220e-10 ,9.64550e-10 , &
      1.00623e-09 ,1.04957e-09 ,1.09429e-09 ,1.14079e-09 ,1.18882e-09 , &
      1.23848e-09 ,1.28986e-09 ,1.34301e-09 ,1.39796e-09 ,1.45493e-09 , &
      1.51372e-09 ,1.57440e-09 ,1.63702e-09 ,1.70173e-09 ,1.76874e-09 , &
      1.83753e-09 ,1.90898e-09 ,1.98250e-09 ,2.05836e-09 ,2.13646e-09 /)
      totplnkderiv(151:181,16) = (/ &
      2.21710e-09 ,2.30027e-09 ,2.38591e-09 ,2.47432e-09 ,2.56503e-09 , &
      2.65878e-09 ,2.75516e-09 ,2.85432e-09 ,2.95688e-09 ,3.06201e-09 , &
      3.17023e-09 ,3.28153e-09 ,3.39604e-09 ,3.51391e-09 ,3.63517e-09 , &
      3.75955e-09 ,3.88756e-09 ,4.01880e-09 ,4.15405e-09 ,4.29255e-09 , &
      4.43535e-09 ,4.58145e-09 ,4.73165e-09 ,4.88560e-09 ,5.04390e-09 , &
      5.20630e-09 ,5.37255e-09 ,5.54355e-09 ,5.71915e-09 ,5.89855e-09 , &
      6.08280e-09 /)
      totplk16deriv(1:50) = (/ &
      4.35811e-14 ,5.01270e-14 ,5.75531e-14 ,6.59588e-14 ,7.54735e-14 , &
      8.62147e-14 ,9.83225e-14 ,1.11951e-13 ,1.27266e-13 ,1.44456e-13 , &
      1.63715e-13 ,1.85257e-13 ,2.09343e-13 ,2.36209e-13 ,2.66136e-13 , &
      2.99486e-13 ,3.36493e-13 ,3.77582e-13 ,4.23146e-13 ,4.73578e-13 , &
      5.29332e-13 ,5.90936e-13 ,6.58891e-13 ,7.33710e-13 ,8.16135e-13 , &
      9.06705e-13 ,1.00614e-12 ,1.11524e-12 ,1.23477e-12 ,1.36561e-12 , &
      1.50871e-12 ,1.66488e-12 ,1.83552e-12 ,2.02123e-12 ,2.22375e-12 , &
      2.44389e-12 ,2.68329e-12 ,2.94338e-12 ,3.22570e-12 ,3.53129e-12 , &
      3.86236e-12 ,4.22086e-12 ,4.60827e-12 ,5.02666e-12 ,5.47890e-12 , &
      5.96595e-12 ,6.49057e-12 ,7.05592e-12 ,7.66401e-12 ,8.31821e-12 /)
      totplk16deriv(51:100) = (/ &
      9.01998e-12 ,9.77390e-12 ,1.05826e-11 ,1.14491e-11 ,1.23769e-11 , &
      1.33709e-11 ,1.44341e-11 ,1.55706e-11 ,1.67821e-11 ,1.80793e-11 , &
      1.94586e-11 ,2.09316e-11 ,2.25007e-11 ,2.41685e-11 ,2.59454e-11 , &
      2.78356e-11 ,2.98440e-11 ,3.19744e-11 ,3.42355e-11 ,3.66340e-11 , &
      3.91772e-11 ,4.18773e-11 ,4.47339e-11 ,4.77509e-11 ,5.09490e-11 , &
      5.43240e-11 ,5.78943e-11 ,6.16648e-11 ,6.56445e-11 ,6.98412e-11 , &
      7.42680e-11 ,7.89335e-11 ,8.38450e-11 ,8.90220e-11 ,9.44695e-11 , &
      1.00197e-10 ,1.06221e-10 ,1.12550e-10 ,1.19193e-10 ,1.26175e-10 , &
      1.33498e-10 ,1.41188e-10 ,1.49251e-10 ,1.57693e-10 ,1.66530e-10 , &
      1.75798e-10 ,1.85495e-10 ,1.95661e-10 ,2.06275e-10 ,2.17357e-10 /)
      totplk16deriv(101:150) = (/ &
      2.28959e-10 ,2.41085e-10 ,2.53739e-10 ,2.66944e-10 ,2.80755e-10 , &
      2.95121e-10 ,3.10141e-10 ,3.25748e-10 ,3.42057e-10 ,3.59026e-10 , &
      3.76668e-10 ,3.95066e-10 ,4.14211e-10 ,4.34111e-10 ,4.54818e-10 , &
      4.76295e-10 ,4.98681e-10 ,5.21884e-10 ,5.46000e-10 ,5.71015e-10 , &
      5.97065e-10 ,6.23965e-10 ,6.51865e-10 ,6.80905e-10 ,7.11005e-10 , &
      7.42100e-10 ,7.74350e-10 ,8.07745e-10 ,8.42355e-10 ,8.78185e-10 , &
      9.15130e-10 ,9.53520e-10 ,9.93075e-10 ,1.03415e-09 ,1.07649e-09 , &
      1.12021e-09 ,1.16539e-09 ,1.21207e-09 ,1.26025e-09 ,1.31014e-09 , &
      1.36156e-09 ,1.41453e-09 ,1.46909e-09 ,1.52540e-09 ,1.58368e-09 , &
      1.64334e-09 ,1.70527e-09 ,1.76888e-09 ,1.83442e-09 ,1.90182e-09 /)
      totplk16deriv(151:181) = (/ &
      1.97128e-09 ,2.04281e-09 ,2.11635e-09 ,2.19219e-09 ,2.26979e-09 , &
      2.34989e-09 ,2.43219e-09 ,2.51660e-09 ,2.60396e-09 ,2.69317e-09 , &
      2.78501e-09 ,2.87927e-09 ,2.97600e-09 ,3.07548e-09 ,3.17772e-09 , &
      3.28235e-09 ,3.38982e-09 ,3.49985e-09 ,3.61307e-09 ,3.72883e-09 , &
      3.84805e-09 ,3.96975e-09 ,4.09465e-09 ,4.22240e-09 ,4.35370e-09 , &
      4.48800e-09 ,4.62535e-09 ,4.76640e-09 ,4.91110e-09 ,5.05850e-09 , &
      5.20965e-09 /)

      end subroutine lwavplankderiv

      end module rrtmg_lw_setcoef_f


      module rrtmg_lw_init_f 1,2

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

! ------- Modules -------
!      use parkind, only : im => kind , rb => kind 
      use rrlw_wvn_f
      use rrtmg_lw_setcoef_f, only: lwatmref, lwavplank, lwavplankderiv

      implicit none

      contains

! **************************************************************************

      subroutine rrtmg_lw_ini(cpdair) 2,49
! **************************************************************************
!
!  Original version:       Michael J. Iacono; July, 1998
!  First revision for GCMs:   September, 1998
!  Second revision for RRTM_V3.0:  September, 2002
!
!  This subroutine performs calculations necessary for the initialization
!  of the longwave model.  Lookup tables are computed for use in the LW
!  radiative transfer, and input absorption coefficient data for each
!  spectral band are reduced from 256 g-point intervals to 140.
! **************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw
      use rrlw_tbl_f, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl, tfn_tbl
      use rrlw_vsn_f, only: hvrini, hnamini

      real , intent(in) :: cpdair     ! Specific heat capacity of dry air
                                      ! at constant pressure at 273 K
                                      ! (J kg-1 K-1)

! ------- Local -------

      integer  :: itr, ibnd, igc, ig, ind, ipr 
      integer  :: igcsm, iprsm

      real  :: wtsum, wtsm(mg)        !
      real  :: tfn                    !

      real , parameter :: expeps = 1.e-20    ! Smallest value for exponential table

! ------- Definitions -------
!     Arrays for 10000-point look-up tables:
!     TAU_TBL Clear-sky optical depth (used in cloudy radiative transfer)
!     EXP_TBL Exponential lookup table for ransmittance
!     TFN_TBL Tau transition function; i.e. the transition of the Planck
!             function from that for the mean layer temperature to that for
!             the layer boundary temperature as a function of optical depth.
!             The "linear in tau" method is used to make the table.
!     PADE    Pade approximation constant (= 0.278)
!     BPADE   Inverse of the Pade approximation constant
!

      hvrini = '$Revision: 1.1.1.2 $'

! Initialize model data
      call lwdatinit(cpdair)
      call lwcmbdat               ! g-point interval reduction data
      call lwcldpr                ! cloud optical properties
      call lwatmref               ! reference MLS profile
      call lwavplank              ! Planck function 
      call lwavplankderiv         ! Planck function derivative wrt temp
! Moved to module_ra_rrtmg_lw for WRF
!      call lw_kgb01               ! molecular absorption coefficients
!      call lw_kgb02
!      call lw_kgb03
!      call lw_kgb04
!      call lw_kgb05
!      call lw_kgb06
!      call lw_kgb07
!      call lw_kgb08
!      call lw_kgb09
!      call lw_kgb10
!      call lw_kgb11
!      call lw_kgb12
!      call lw_kgb13
!      call lw_kgb14
!      call lw_kgb15
!      call lw_kgb16

! Compute lookup tables for transmittance, tau transition function,
! and clear sky tau (for the cloudy sky radiative transfer).  Tau is 
! computed as a function of the tau transition function, transmittance 
! is calculated as a function of tau, and the tau transition function 
! is calculated using the linear in tau formulation at values of tau 
! above 0.01.  TF is approximated as tau/6 for tau < 0.01.  All tables 
! are computed at intervals of 0.001.  The inverse of the constant used
! in the Pade approximation to the tau transition function is set to b.

      tau_tbl(0) = 0.0 
      tau_tbl(ntbl) = 1.e10 
      exp_tbl(0) = 1.0 
      exp_tbl(ntbl) = expeps
      tfn_tbl(0) = 0.0 
      tfn_tbl(ntbl) = 1.0 
      bpade = 1.0  / pade
      do itr = 1, ntbl-1
         tfn = float(itr) / float(ntbl)
         tau_tbl(itr) = bpade * tfn / (1.  - tfn)
         exp_tbl(itr) = exp(-tau_tbl(itr))
         if (exp_tbl(itr) .le. expeps) exp_tbl(itr) = expeps
         if (tau_tbl(itr) .lt. 0.06 ) then
            tfn_tbl(itr) = tau_tbl(itr)/6. 
         else
            tfn_tbl(itr) = 1. -2. *((1. /tau_tbl(itr))-(exp_tbl(itr)/(1.-exp_tbl(itr))))
         endif
      enddo

! Perform g-point reduction from 16 per band (256 total points) to
! a band dependant number (140 total points) for all absorption
! coefficient input data and Planck fraction input data.
! Compute relative weighting for new g-point combinations.

      igcsm = 0
      do ibnd = 1,nbndlw
         iprsm = 0
         if (ngc(ibnd).lt.mg) then
            do igc = 1,ngc(ibnd) 
               igcsm = igcsm + 1
               wtsum = 0. 
               do ipr = 1, ngn(igcsm)
                  iprsm = iprsm + 1
                  wtsum = wtsum + wt(iprsm)
               enddo
               wtsm(igc) = wtsum
            enddo
            do ig = 1, ng(ibnd)
               ind = (ibnd-1)*mg + ig
               rwgt(ind) = wt(ig)/wtsm(ngm(ind))
            enddo
         else
            do ig = 1, ng(ibnd)
               igcsm = igcsm + 1
               ind = (ibnd-1)*mg + ig
               rwgt(ind) = 1.0 
            enddo
         endif
      enddo

! Reduce g-points for absorption coefficient data in each LW spectral band.

      call cmbgb1
      call cmbgb2
      call cmbgb3
      call cmbgb4
      call cmbgb5
      call cmbgb6
      call cmbgb7
      call cmbgb8
      call cmbgb9
      call cmbgb10
      call cmbgb11
      call cmbgb12
      call cmbgb13
      call cmbgb14
      call cmbgb15
      call cmbgb16

      end subroutine rrtmg_lw_ini

!***************************************************************************

      subroutine lwdatinit(cpdair) 2,6
!***************************************************************************

! --------- Modules ----------

      use parrrtm_f, only : maxxsec, maxinpx
      use rrlw_con_f, only: heatfac, grav, planck, boltz, &
                          clight, avogad, alosmt, gascon, radcn1, radcn2, &
                          sbcnst, secdy 
      use rrlw_vsn_f

      save 
 
      real , intent(in) :: cpdair      ! Specific heat capacity of dry air
                                       ! at constant pressure at 273 K
                                       ! (J kg-1 K-1)

! Longwave spectral band limits (wavenumbers)
      wavenum1(:) = (/ 10. , 350. , 500. , 630. , 700. , 820. , &
                      980. ,1080. ,1180. ,1390. ,1480. ,1800. , &
                     2080. ,2250. ,2380. ,2600. /)
      wavenum2(:) = (/350. , 500. , 630. , 700. , 820. , 980. , &
                     1080. ,1180. ,1390. ,1480. ,1800. ,2080. , &
                     2250. ,2380. ,2600. ,3250. /)
      delwave(:) =  (/340. , 150. , 130. ,  70. , 120. , 160. , &
                      100. , 100. , 210. ,  90. , 320. , 280. , &
                      170. , 130. , 220. , 650. /)

! Spectral band information
      ng(:) = (/16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/)
      nspa(:) = (/1,1,9,9,9,1,9,1,9,1,1,9,9,1,9,9/)
      nspb(:) = (/1,1,5,5,5,0,1,1,1,1,1,0,0,1,0,0/)

!     nxmol     - number of cross-sections input by user
!     ixindx(i) - index of cross-section molecule corresponding to Ith
!                 cross-section specified by user
!                 = 0 -- not allowed in rrtm
!                 = 1 -- ccl4
!                 = 2 -- cfc11
!                 = 3 -- cfc12
!                 = 4 -- cfc22
      nxmol = 4
      ixindx(1) = 1
      ixindx(2) = 2
      ixindx(3) = 3
      ixindx(4) = 4
      ixindx(5:maxinpx) = 0

! Fundamental physical constants from NIST 2002

      grav = 9.8066                         ! Acceleration of gravity
                                              ! (m s-2)
      planck = 6.62606876e-27               ! Planck constant
                                              ! (ergs s; g cm2 s-1)
      boltz = 1.3806503e-16                 ! Boltzmann constant
                                              ! (ergs K-1; g cm2 s-2 K-1)
      clight = 2.99792458e+10               ! Speed of light in a vacuum  
                                              ! (cm s-1)
      avogad = 6.02214199e+23               ! Avogadro constant
                                              ! (mol-1)
      alosmt = 2.6867775e+19                ! Loschmidt constant
                                              ! (cm-3)
      gascon = 8.31447200e+07               ! Molar gas constant
                                              ! (ergs mol-1 K-1)
      radcn1 = 1.191042722e-12              ! First radiation constant
                                              ! (W cm2 sr-1)
      radcn2 = 1.4387752                    ! Second radiation constant
                                              ! (cm K)
      sbcnst = 5.670400e-04                 ! Stefan-Boltzmann constant
                                              ! (W cm-2 K-4)
      secdy = 8.6400e4                      ! Number of seconds per day
                                              ! (s d-1)
!
!     units are generally cgs
!
!     The first and second radiation constants are taken from NIST.
!     They were previously obtained from the relations:
!          radcn1 = 2.*planck*clight*clight*1.e-07
!          radcn2 = planck*clight/boltz

!     Heatfac is the factor by which delta-flux / delta-pressure is
!     multiplied, with flux in W/m-2 and pressure in mbar, to get 
!     the heating rate in units of degrees/day.  It is equal to:
!     Original value:
!           (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
!           Here, cpdair (1.004) is in units of J g-1 K-1, and the 
!           constant (1.e-5) converts mb to Pa and g-1 to kg-1.
!        =  (9.8066)(86400)(1e-5)/(1.004)
!      heatfac = 8.4391 
!
!     Modified value for consistency with CAM3:
!           (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
!           Here, cpdair (1.00464) is in units of J g-1 K-1, and the
!           constant (1.e-5) converts mb to Pa and g-1 to kg-1.
!        =  (9.80616)(86400)(1e-5)/(1.00464)
!      heatfac = 8.43339130434 
!
!     Calculated value:
!        (grav) x (#sec/day) / (specific heat of dry air at const. p x 1.e2)
!           Here, cpdair is in units of J kg-1 K-1, and the constant (1.e2) 
!           converts mb to Pa when heatfac is multiplied by W m-2 mb-1. 
      heatfac = grav * secdy / (cpdair * 1.e2 )

      end subroutine lwdatinit

!***************************************************************************

      subroutine lwcmbdat 2
!***************************************************************************

      save
 
! ------- Definitions -------
!     Arrays for the g-point reduction from 256 to 140 for the 16 LW bands:
!     This mapping from 256 to 140 points has been carefully selected to 
!     minimize the effect on the resulting fluxes and cooling rates, and
!     caution should be used if the mapping is modified.  The full 256
!     g-point set can be restored with ngptlw=256, ngc=16*16, ngn=256*1., etc.
!     ngptlw  The total number of new g-points
!     ngc     The number of new g-points in each band
!     ngs     The cumulative sum of new g-points for each band
!     ngm     The index of each new g-point relative to the original
!             16 g-points for each band.  
!     ngn     The number of original g-points that are combined to make
!             each new g-point in each band.
!     ngb     The band index for each new g-point.
!     wt      RRTM weights for 16 g-points.

! ------- Data statements -------
      ngc(:) = (/10,12,16,14,16,8,12,8,12,6,8,8,4,2,2,2/)
      ngs(:) = (/10,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/)
      ngm(:) = (/1,2,3,3,4,4,5,5,6,6,7,7,8,8,9,10, &          ! band 1
                 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, &     ! band 2
                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 3
                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, &    ! band 4
                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 5
                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &           ! band 6
                 1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, &      ! band 7
                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &           ! band 8
                 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, &     ! band 9
                 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, &           ! band 10
                 1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, &           ! band 11
                 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &           ! band 12
                 1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, &           ! band 13
                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &           ! band 14
                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &           ! band 15
                 1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2/)            ! band 16
      ngn(:) = (/1,1,2,2,2,2,2,2,1,1, &                       ! band 1
                 1,1,1,1,1,1,1,1,2,2,2,2, &                   ! band 2
                 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 3
                 1,1,1,1,1,1,1,1,1,1,1,1,1,3, &               ! band 4
                 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 5
                 2,2,2,2,2,2,2,2, &                           ! band 6
                 2,2,1,1,1,1,1,1,1,1,2,2, &                   ! band 7
                 2,2,2,2,2,2,2,2, &                           ! band 8
                 1,1,1,1,1,1,1,1,2,2,2,2, &                   ! band 9
                 2,2,2,2,4,4, &                               ! band 10
                 1,1,2,2,2,2,3,3, &                           ! band 11
                 1,1,1,1,2,2,4,4, &                           ! band 12
                 3,3,4,6, &                                   ! band 13
                 8,8, &                                       ! band 14
                 8,8, &                                       ! band 15
                 4,12/)                                       ! band 16
      ngb(:) = (/1,1,1,1,1,1,1,1,1,1, &                       ! band 1
                 2,2,2,2,2,2,2,2,2,2,2,2, &                   ! band 2
                 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, &           ! band 3
                 4,4,4,4,4,4,4,4,4,4,4,4,4,4, &               ! band 4
                 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, &           ! band 5
                 6,6,6,6,6,6,6,6, &                           ! band 6
                 7,7,7,7,7,7,7,7,7,7,7,7, &                   ! band 7
                 8,8,8,8,8,8,8,8, &                           ! band 8
                 9,9,9,9,9,9,9,9,9,9,9,9, &                   ! band 9
                 10,10,10,10,10,10, &                         ! band 10
                 11,11,11,11,11,11,11,11, &                   ! band 11
                 12,12,12,12,12,12,12,12, &                   ! band 12
                 13,13,13,13, &                               ! band 13
                 14,14, &                                     ! band 14
                 15,15, &                                     ! band 15
                 16,16/)                                      ! band 16
      wt(:) = (/ 0.1527534276 , 0.1491729617 , 0.1420961469 , &
                 0.1316886544 , 0.1181945205 , 0.1019300893 , &
                 0.0832767040 , 0.0626720116 , 0.0424925000 , &
                 0.0046269894 , 0.0038279891 , 0.0030260086 , &
                 0.0022199750 , 0.0014140010 , 0.0005330000 , &
                 0.0000750000 /)

      end subroutine lwcmbdat

!***************************************************************************

      subroutine cmbgb1 3,4
!***************************************************************************
!
!  Original version:    MJIacono; July 1998
!  Revision for GCMs:   MJIacono; September 1998
!  Revision for RRTMG:  MJIacono, September 2002
!  Revision for F90 reformatting:  MJIacono, June 2006
!
!  The subroutines CMBGB1->CMBGB16 input the absorption coefficient
!  data for each band, which are defined for 16 g-points and 16 spectral
!  bands. The data are combined with appropriate weighting following the
!  g-point mapping arrays specified in RRTMINIT.  Plank fraction data
!  in arrays FRACREFA and FRACREFB are combined without weighting.  All
!  g-point reduced data are put into new arrays for use in RRTM.
!
!  band 1:  10-350 cm-1 (low key - h2o; low minor - n2)
!                       (high key - h2o; high minor - n2)
!  note: previous versions of rrtm band 1: 
!        10-250 cm-1 (low - h2o; high - h2o)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng1
      use rrlw_kg01_f, only: fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, &
                           selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mn2, kb_mn2, &
                           selfref, forref

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumk1, sumk2, sumf1, sumf2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(1)
               sumk = 0.
               do ipr = 1, ngn(igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(1)
               sumk = 0.
               do ipr = 1, ngn(igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(1)
            sumk = 0.
            do ipr = 1, ngn(igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(1)
            sumk = 0.
            do ipr = 1, ngn(igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(1)
            sumk1 = 0.
            sumk2 = 0.
            do ipr = 1, ngn(igc)
               iprsm = iprsm + 1
               sumk1 = sumk1 + kao_mn2(jt,iprsm)*rwgt(iprsm)
               sumk2 = sumk2 + kbo_mn2(jt,iprsm)*rwgt(iprsm)
            enddo
            ka_mn2(jt,igc) = sumk1
            kb_mn2(jt,igc) = sumk2
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(1)
         sumf1 = 0.
         sumf2 = 0.
         do ipr = 1, ngn(igc)
            iprsm = iprsm + 1
            sumf1= sumf1+ fracrefao(iprsm)
            sumf2= sumf2+ fracrefbo(iprsm)
         enddo
         fracrefa(igc) = sumf1
         fracrefb(igc) = sumf2
      enddo

      end subroutine cmbgb1

!***************************************************************************

      subroutine cmbgb2 3,4
!***************************************************************************
!
!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
!
!     note: previous version of rrtm band 2: 
!           250 - 500 cm-1 (low - h2o; high - h2o)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng2
      use rrlw_kg02_f, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf1, sumf2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(2)
               sumk = 0.
               do ipr = 1, ngn(ngs(1)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+16)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(2)
               sumk = 0.
               do ipr = 1, ngn(ngs(1)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+16)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(2)
            sumk = 0.
            do ipr = 1, ngn(ngs(1)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+16)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(2)
            sumk = 0.
            do ipr = 1, ngn(ngs(1)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+16)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(2)
         sumf1 = 0.
         sumf2 = 0.
         do ipr = 1, ngn(ngs(1)+igc)
            iprsm = iprsm + 1
            sumf1= sumf1+ fracrefao(iprsm)
            sumf2= sumf2+ fracrefbo(iprsm)
         enddo
         fracrefa(igc) = sumf1
         fracrefb(igc) = sumf2
      enddo

      end subroutine cmbgb2

!***************************************************************************

      subroutine cmbgb3 3,4
!***************************************************************************
!
!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
!                           (high key - h2o,co2; high minor - n2o)
!
! old band 3:  500-630 cm-1 (low - h2o,co2; high - h2o,co2)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng3
      use rrlw_kg03_f, only: fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, &
                           selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mn2o, kb_mn2o, &
                           selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(3)
                 sumk = 0.
                  do ipr = 1, ngn(ngs(2)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+32)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo
      do jn = 1,5
         do jt = 1,5
            do jp = 13,59
               iprsm = 0
               do igc = 1,ngc(3)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(2)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+32)
                  enddo
                  kb(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jn = 1,9
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(3)
              sumk = 0.
               do ipr = 1, ngn(ngs(2)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+32)
               enddo
               ka_mn2o(jn,jt,igc) = sumk
            enddo
         enddo
      enddo

      do jn = 1,5
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(3)
              sumk = 0.
               do ipr = 1, ngn(ngs(2)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo_mn2o(jn,jt,iprsm)*rwgt(iprsm+32)
               enddo
               kb_mn2o(jn,jt,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(3)
            sumk = 0.
            do ipr = 1, ngn(ngs(2)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+32)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(3)
            sumk = 0.
            do ipr = 1, ngn(ngs(2)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+32)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(3)
            sumf = 0.
            do ipr = 1, ngn(ngs(2)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      do jp = 1,5
         iprsm = 0
         do igc = 1,ngc(3)
            sumf = 0.
            do ipr = 1, ngn(ngs(2)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefbo(iprsm,jp)
            enddo
            fracrefb(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb3

!***************************************************************************

      subroutine cmbgb4 3,4
!***************************************************************************
!
!     band 4:  630-700 cm-1 (low key - h2o,co2; high key - o3,co2)
!
! old band 4:  630-700 cm-1 (low - h2o,co2; high - o3,co2)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng4
      use rrlw_kg04_f, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(4)
                 sumk = 0.
                  do ipr = 1, ngn(ngs(3)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+48)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo
      do jn = 1,5
         do jt = 1,5
            do jp = 13,59
               iprsm = 0
               do igc = 1,ngc(4)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(3)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+48)
                  enddo
                  kb(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(4)
            sumk = 0.
            do ipr = 1, ngn(ngs(3)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+48)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(4)
            sumk = 0.
            do ipr = 1, ngn(ngs(3)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+48)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(4)
            sumf = 0.
            do ipr = 1, ngn(ngs(3)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      do jp = 1,5
         iprsm = 0
         do igc = 1,ngc(4)
            sumf = 0.
            do ipr = 1, ngn(ngs(3)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefbo(iprsm,jp)
            enddo
            fracrefb(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb4

!***************************************************************************

      subroutine cmbgb5 3,4
!***************************************************************************
!
!     band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
!                           (high key - o3,co2)
!
! old band 5:  700-820 cm-1 (low - h2o,co2; high - o3,co2)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng5
      use rrlw_kg05_f, only: fracrefao, fracrefbo, kao, kbo, kao_mo3, ccl4o, &
                           selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mo3, ccl4, &
                           selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(5)
                 sumk = 0.
                  do ipr = 1, ngn(ngs(4)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+64)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo
      do jn = 1,5
         do jt = 1,5
            do jp = 13,59
               iprsm = 0
               do igc = 1,ngc(5)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(4)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+64)
                  enddo
                  kb(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jn = 1,9
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(5)
              sumk = 0.
               do ipr = 1, ngn(ngs(4)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao_mo3(jn,jt,iprsm)*rwgt(iprsm+64)
               enddo
               ka_mo3(jn,jt,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(5)
            sumk = 0.
            do ipr = 1, ngn(ngs(4)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+64)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(5)
            sumk = 0.
            do ipr = 1, ngn(ngs(4)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+64)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(5)
            sumf = 0.
            do ipr = 1, ngn(ngs(4)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      do jp = 1,5
         iprsm = 0
         do igc = 1,ngc(5)
            sumf = 0.
            do ipr = 1, ngn(ngs(4)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefbo(iprsm,jp)
            enddo
            fracrefb(igc,jp) = sumf
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(5)
         sumk = 0.
         do ipr = 1, ngn(ngs(4)+igc)
            iprsm = iprsm + 1
            sumk = sumk + ccl4o(iprsm)*rwgt(iprsm+64)
         enddo
         ccl4(igc) = sumk
      enddo

      end subroutine cmbgb5

!***************************************************************************

      subroutine cmbgb6 3,4
!***************************************************************************
!
!     band 6:  820-980 cm-1 (low key - h2o; low minor - co2)
!                           (high key - nothing; high minor - cfc11, cfc12)
!
! old band 6:  820-980 cm-1 (low - h2o; high - nothing)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng6
      use rrlw_kg06_f, only: fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, &
                           selfrefo, forrefo, &
                           fracrefa, absa, ka, ka_mco2, cfc11adj, cfc12, &
                           selfref, forref

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf, sumk1, sumk2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(6)
               sumk = 0.
               do ipr = 1, ngn(ngs(5)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+80)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(6)
            sumk = 0.
            do ipr = 1, ngn(ngs(5)+igc)
               iprsm = iprsm + 1
               sumk = sumk + kao_mco2(jt,iprsm)*rwgt(iprsm+80)
            enddo
            ka_mco2(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(6)
            sumk = 0.
            do ipr = 1, ngn(ngs(5)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+80)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(6)
            sumk = 0.
            do ipr = 1, ngn(ngs(5)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+80)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(6)
         sumf = 0.
         sumk1= 0.
         sumk2= 0.
         do ipr = 1, ngn(ngs(5)+igc)
            iprsm = iprsm + 1
            sumf = sumf + fracrefao(iprsm)
            sumk1= sumk1+ cfc11adjo(iprsm)*rwgt(iprsm+80)
            sumk2= sumk2+ cfc12o(iprsm)*rwgt(iprsm+80)
         enddo
         fracrefa(igc) = sumf
         cfc11adj(igc) = sumk1
         cfc12(igc) = sumk2
      enddo

      end subroutine cmbgb6

!***************************************************************************

      subroutine cmbgb7 3,4
!***************************************************************************
!
!     band 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
!                            (high key - o3; high minor - co2)
!
! old band 7:  980-1080 cm-1 (low - h2o,o3; high - o3)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng7
      use rrlw_kg07_f, only: fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, &
                           selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mco2, kb_mco2, &
                           selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(7)
                 sumk = 0.
                  do ipr = 1, ngn(ngs(6)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+96)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo
      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(7)
               sumk = 0.
               do ipr = 1, ngn(ngs(6)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+96)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jn = 1,9
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(7)
              sumk = 0.
               do ipr = 1, ngn(ngs(6)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+96)
               enddo
               ka_mco2(jn,jt,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(7)
            sumk = 0.
            do ipr = 1, ngn(ngs(6)+igc)
               iprsm = iprsm + 1
               sumk = sumk + kbo_mco2(jt,iprsm)*rwgt(iprsm+96)
            enddo
            kb_mco2(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(7)
            sumk = 0.
            do ipr = 1, ngn(ngs(6)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+96)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(7)
            sumk = 0.
            do ipr = 1, ngn(ngs(6)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+96)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(7)
            sumf = 0.
            do ipr = 1, ngn(ngs(6)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(7)
         sumf = 0.
         do ipr = 1, ngn(ngs(6)+igc)
            iprsm = iprsm + 1
            sumf = sumf + fracrefbo(iprsm)
         enddo
         fracrefb(igc) = sumf
      enddo

      end subroutine cmbgb7

!***************************************************************************

      subroutine cmbgb8 3,4
!***************************************************************************
!
!     band 8:  1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
!                             (high key - o3; high minor - co2, n2o)
!
! old band 8:  1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng8
      use rrlw_kg08_f, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, &
                           kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, &
                           cfc12o, cfc22adjo, &
                           fracrefa, fracrefb, absa, ka, ka_mco2, ka_mn2o, &
                           ka_mo3, absb, kb, kb_mco2, kb_mn2o, selfref, forref, &
                           cfc12, cfc22adj

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumk1, sumk2, sumk3, sumk4, sumk5, sumf1, sumf2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(8)
              sumk = 0.
               do ipr = 1, ngn(ngs(7)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+112)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
      enddo
      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(8)
               sumk = 0.
               do ipr = 1, ngn(ngs(7)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+112)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(8)
            sumk = 0.
            do ipr = 1, ngn(ngs(7)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+112)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(8)
            sumk = 0.
            do ipr = 1, ngn(ngs(7)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+112)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(8)
            sumk1 = 0.
            sumk2 = 0.
            sumk3 = 0.
            sumk4 = 0.
            sumk5 = 0.
            do ipr = 1, ngn(ngs(7)+igc)
               iprsm = iprsm + 1
               sumk1 = sumk1 + kao_mco2(jt,iprsm)*rwgt(iprsm+112)
               sumk2 = sumk2 + kbo_mco2(jt,iprsm)*rwgt(iprsm+112)
               sumk3 = sumk3 + kao_mo3(jt,iprsm)*rwgt(iprsm+112)
               sumk4 = sumk4 + kao_mn2o(jt,iprsm)*rwgt(iprsm+112)
               sumk5 = sumk5 + kbo_mn2o(jt,iprsm)*rwgt(iprsm+112)
            enddo
            ka_mco2(jt,igc) = sumk1
            kb_mco2(jt,igc) = sumk2
            ka_mo3(jt,igc) = sumk3
            ka_mn2o(jt,igc) = sumk4
            kb_mn2o(jt,igc) = sumk5
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(8)
         sumf1= 0.
         sumf2= 0.
         sumk1= 0.
         sumk2= 0.
         do ipr = 1, ngn(ngs(7)+igc)
            iprsm = iprsm + 1
            sumf1= sumf1+ fracrefao(iprsm)
            sumf2= sumf2+ fracrefbo(iprsm)
            sumk1= sumk1+ cfc12o(iprsm)*rwgt(iprsm+112)
            sumk2= sumk2+ cfc22adjo(iprsm)*rwgt(iprsm+112)
         enddo
         fracrefa(igc) = sumf1
         fracrefb(igc) = sumf2
         cfc12(igc) = sumk1
         cfc22adj(igc) = sumk2
      enddo

      end subroutine cmbgb8

!***************************************************************************

      subroutine cmbgb9 3,4
!***************************************************************************
!
!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
!                             (high key - ch4; high minor - n2o)!

! old band 9:  1180-1390 cm-1 (low - h2o,ch4; high - ch4)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng9
      use rrlw_kg09_f, only: fracrefao, fracrefbo, kao, kao_mn2o, &
                           kbo, kbo_mn2o, selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, ka_mn2o, &
                           absb, kb, kb_mn2o, selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(9)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(8)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+128)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(9)
               sumk = 0.
               do ipr = 1, ngn(ngs(8)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+128)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jn = 1,9
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(9)
              sumk = 0.
               do ipr = 1, ngn(ngs(8)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+128)
               enddo
               ka_mn2o(jn,jt,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(9)
            sumk = 0.
            do ipr = 1, ngn(ngs(8)+igc)
               iprsm = iprsm + 1
               sumk = sumk + kbo_mn2o(jt,iprsm)*rwgt(iprsm+128)
            enddo
            kb_mn2o(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(9)
            sumk = 0.
            do ipr = 1, ngn(ngs(8)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+128)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(9)
            sumk = 0.
            do ipr = 1, ngn(ngs(8)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+128)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(9)
            sumf = 0.
            do ipr = 1, ngn(ngs(8)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(9)
         sumf = 0.
         do ipr = 1, ngn(ngs(8)+igc)
            iprsm = iprsm + 1
            sumf = sumf + fracrefbo(iprsm)
         enddo
         fracrefb(igc) = sumf
      enddo

      end subroutine cmbgb9

!***************************************************************************

      subroutine cmbgb10 3,4
!***************************************************************************
!
!     band 10:  1390-1480 cm-1 (low key - h2o; high key - h2o)
!
! old band 10:  1390-1480 cm-1 (low - h2o; high - h2o)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng10
      use rrlw_kg10_f, only: fracrefao, fracrefbo, kao, kbo, &
                           selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, &
                           selfref, forref

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf1, sumf2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(10)
               sumk = 0.
               do ipr = 1, ngn(ngs(9)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+144)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(10)
               sumk = 0.
               do ipr = 1, ngn(ngs(9)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+144)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(10)
            sumk = 0.
            do ipr = 1, ngn(ngs(9)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+144)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(10)
            sumk = 0.
            do ipr = 1, ngn(ngs(9)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+144)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(10)
         sumf1= 0.
         sumf2= 0.
         do ipr = 1, ngn(ngs(9)+igc)
            iprsm = iprsm + 1
            sumf1= sumf1+ fracrefao(iprsm)
            sumf2= sumf2+ fracrefbo(iprsm)
         enddo
         fracrefa(igc) = sumf1
         fracrefb(igc) = sumf2
      enddo

      end subroutine cmbgb10

!***************************************************************************

      subroutine cmbgb11 3,4
!***************************************************************************
!
!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
!                              (high key - h2o; high minor - o2)
!
! old band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
!                              (high key - h2o; high minor - o2)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng11
      use rrlw_kg11_f, only: fracrefao, fracrefbo, kao, kao_mo2, &
                           kbo, kbo_mo2, selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, ka_mo2, &
                           absb, kb, kb_mo2, selfref, forref

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumk1, sumk2, sumf1, sumf2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(11)
               sumk = 0.
               do ipr = 1, ngn(ngs(10)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+160)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
      enddo
      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(11)
               sumk = 0.
               do ipr = 1, ngn(ngs(10)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+160)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(11)
            sumk1 = 0.
            sumk2 = 0.
            do ipr = 1, ngn(ngs(10)+igc)
               iprsm = iprsm + 1
               sumk1 = sumk1 + kao_mo2(jt,iprsm)*rwgt(iprsm+160)
               sumk2 = sumk2 + kbo_mo2(jt,iprsm)*rwgt(iprsm+160)
            enddo
            ka_mo2(jt,igc) = sumk1
            kb_mo2(jt,igc) = sumk2
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(11)
            sumk = 0.
            do ipr = 1, ngn(ngs(10)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+160)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(11)
            sumk = 0.
            do ipr = 1, ngn(ngs(10)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+160)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(11)
         sumf1= 0.
         sumf2= 0.
         do ipr = 1, ngn(ngs(10)+igc)
            iprsm = iprsm + 1
            sumf1= sumf1+ fracrefao(iprsm)
            sumf2= sumf2+ fracrefbo(iprsm)
         enddo
         fracrefa(igc) = sumf1
         fracrefb(igc) = sumf2
      enddo

      end subroutine cmbgb11

!***************************************************************************

      subroutine cmbgb12 3,4
!***************************************************************************
!
!     band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
!
! old band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng12
      use rrlw_kg12_f, only: fracrefao, kao, selfrefo, forrefo, &
                           fracrefa, absa, ka, selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(12)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(11)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+176)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(12)
            sumk = 0.
            do ipr = 1, ngn(ngs(11)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+176)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(12)
            sumk = 0.
            do ipr = 1, ngn(ngs(11)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+176)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(12)
            sumf = 0.
            do ipr = 1, ngn(ngs(11)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb12

!***************************************************************************

      subroutine cmbgb13 3,4
!***************************************************************************
!
!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
!
! old band 13:  2080-2250 cm-1 (low - h2o,n2o; high - nothing)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng13
      use rrlw_kg13_f, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mco, &
                           kbo_mo3, selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, ka_mco2, ka_mco, &
                           kb_mo3, selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumk1, sumk2, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(13)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(12)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+192)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jn = 1,9
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(13)
              sumk1 = 0.
              sumk2 = 0.
               do ipr = 1, ngn(ngs(12)+igc)
                  iprsm = iprsm + 1
                  sumk1 = sumk1 + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+192)
                  sumk2 = sumk2 + kao_mco(jn,jt,iprsm)*rwgt(iprsm+192)
               enddo
               ka_mco2(jn,jt,igc) = sumk1
               ka_mco(jn,jt,igc) = sumk2
            enddo
         enddo
      enddo

      do jt = 1,19
         iprsm = 0
         do igc = 1,ngc(13)
            sumk = 0.
            do ipr = 1, ngn(ngs(12)+igc)
               iprsm = iprsm + 1
               sumk = sumk + kbo_mo3(jt,iprsm)*rwgt(iprsm+192)
            enddo
            kb_mo3(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(13)
            sumk = 0.
            do ipr = 1, ngn(ngs(12)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+192)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(13)
            sumk = 0.
            do ipr = 1, ngn(ngs(12)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+192)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(13)
         sumf = 0.
         do ipr = 1, ngn(ngs(12)+igc)
            iprsm = iprsm + 1
            sumf = sumf + fracrefbo(iprsm)
         enddo
         fracrefb(igc) = sumf
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(13)
            sumf = 0.
            do ipr = 1, ngn(ngs(12)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb13

!***************************************************************************

      subroutine cmbgb14 3,4
!***************************************************************************
!
!     band 14:  2250-2380 cm-1 (low - co2; high - co2)
!
! old band 14:  2250-2380 cm-1 (low - co2; high - co2)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng14
      use rrlw_kg14_f, only: fracrefao, fracrefbo, kao, kbo, &
                           selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, &
                           selfref, forref

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf1, sumf2


      do jt = 1,5
         do jp = 1,13
            iprsm = 0
            do igc = 1,ngc(14)
               sumk = 0.
               do ipr = 1, ngn(ngs(13)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+208)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(14)
               sumk = 0.
               do ipr = 1, ngn(ngs(13)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+208)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(14)
            sumk = 0.
            do ipr = 1, ngn(ngs(13)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+208)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(14)
            sumk = 0.
            do ipr = 1, ngn(ngs(13)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+208)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(14)
         sumf1= 0.
         sumf2= 0.
         do ipr = 1, ngn(ngs(13)+igc)
            iprsm = iprsm + 1
            sumf1= sumf1+ fracrefao(iprsm)
            sumf2= sumf2+ fracrefbo(iprsm)
         enddo
         fracrefa(igc) = sumf1
         fracrefb(igc) = sumf2
      enddo

      end subroutine cmbgb14

!***************************************************************************

      subroutine cmbgb15 3,4
!***************************************************************************
!
!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
!                              (high - nothing)
!
! old band 15:  2380-2600 cm-1 (low - n2o,co2; high - nothing)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng15
      use rrlw_kg15_f, only: fracrefao, kao, kao_mn2, selfrefo, forrefo, &
                           fracrefa, absa, ka, ka_mn2, selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(15)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(14)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+224)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jn = 1,9
         do jt = 1,19
            iprsm = 0
            do igc = 1,ngc(15)
              sumk = 0.
               do ipr = 1, ngn(ngs(14)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao_mn2(jn,jt,iprsm)*rwgt(iprsm+224)
               enddo
               ka_mn2(jn,jt,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(15)
            sumk = 0.
            do ipr = 1, ngn(ngs(14)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+224)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(15)
            sumk = 0.
            do ipr = 1, ngn(ngs(14)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+224)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(15)
            sumf = 0.
            do ipr = 1, ngn(ngs(14)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb15

!***************************************************************************

      subroutine cmbgb16 3,4
!***************************************************************************
!
!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
!
! old band 16:  2600-3000 cm-1 (low - h2o,ch4; high - nothing)
!***************************************************************************

      use parrrtm_f, only : mg, nbndlw, ngptlw, ng16
      use rrlw_kg16_f, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
                           fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm 
      real  :: sumk, sumf


      do jn = 1,9
         do jt = 1,5
            do jp = 1,13
               iprsm = 0
               do igc = 1,ngc(16)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(15)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+240)
                  enddo
                  ka(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jt = 1,5
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(16)
               sumk = 0.
               do ipr = 1, ngn(ngs(15)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+240)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      do jt = 1,10
         iprsm = 0
         do igc = 1,ngc(16)
            sumk = 0.
            do ipr = 1, ngn(ngs(15)+igc)
               iprsm = iprsm + 1
               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+240)
            enddo
            selfref(jt,igc) = sumk
         enddo
      enddo

      do jt = 1,4
         iprsm = 0
         do igc = 1,ngc(16)
            sumk = 0.
            do ipr = 1, ngn(ngs(15)+igc)
               iprsm = iprsm + 1
               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+240)
            enddo
            forref(jt,igc) = sumk
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(16)
         sumf = 0.
         do ipr = 1, ngn(ngs(15)+igc)
            iprsm = iprsm + 1
            sumf = sumf + fracrefbo(iprsm)
         enddo
         fracrefb(igc) = sumf
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(16)
            sumf = 0.
            do ipr = 1, ngn(ngs(15)+igc)
               iprsm = iprsm + 1
               sumf = sumf + fracrefao(iprsm,jp)
            enddo
            fracrefa(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb16

!***************************************************************************

      subroutine lwcldpr 2,2
!***************************************************************************

! --------- Modules ----------

      use rrlw_cld_f, only: abscld1, absliq0, absliq1, &
                          absice0, absice1, absice2, absice3

      save

! ABSCLDn is the liquid water absorption coefficient (m2/g). 
! For INFLAG = 1.
      abscld1 = 0.0602410 
!  
! Everything below is for INFLAG = 2.

! ABSICEn(J,IB) are the parameters needed to compute the liquid water 
! absorption coefficient in spectral region IB for ICEFLAG=n.  The units
! of ABSICEn(1,IB) are m2/g and ABSICEn(2,IB) has units (microns (m2/g)).
! For ICEFLAG = 0.

      absice0(:)= (/0.005 ,  1.0 /)

! For ICEFLAG = 1.
      absice1(1,:) = (/0.0036 , 0.0068 , 0.0003 , 0.0016 , 0.0020 /)
      absice1(2,:) = (/1.136  , 0.600  , 1.338  , 1.166  , 1.118  /)

! For ICEFLAG = 2.  In each band, the absorption
! coefficients are listed for a range of effective radii from 5.0
! to 131.0 microns in increments of 3.0 microns.
! Spherical Ice Particle Parameterization
! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)]
      absice2(:,1) = (/ &
! band 1
       7.798999e-02 ,6.340479e-02 ,5.417973e-02 ,4.766245e-02 ,4.272663e-02 , &
       3.880939e-02 ,3.559544e-02 ,3.289241e-02 ,3.057511e-02 ,2.855800e-02 , &
       2.678022e-02 ,2.519712e-02 ,2.377505e-02 ,2.248806e-02 ,2.131578e-02 , &
       2.024194e-02 ,1.925337e-02 ,1.833926e-02 ,1.749067e-02 ,1.670007e-02 , &
       1.596113e-02 ,1.526845e-02 ,1.461739e-02 ,1.400394e-02 ,1.342462e-02 , &
       1.287639e-02 ,1.235656e-02 ,1.186279e-02 ,1.139297e-02 ,1.094524e-02 , &
       1.051794e-02 ,1.010956e-02 ,9.718755e-03 ,9.344316e-03 ,8.985139e-03 , &
       8.640223e-03 ,8.308656e-03 ,7.989606e-03 ,7.682312e-03 ,7.386076e-03 , &
       7.100255e-03 ,6.824258e-03 ,6.557540e-03 /)
      absice2(:,2) = (/ &
! band 2
       2.784879e-02 ,2.709863e-02 ,2.619165e-02 ,2.529230e-02 ,2.443225e-02 , &
       2.361575e-02 ,2.284021e-02 ,2.210150e-02 ,2.139548e-02 ,2.071840e-02 , &
       2.006702e-02 ,1.943856e-02 ,1.883064e-02 ,1.824120e-02 ,1.766849e-02 , &
       1.711099e-02 ,1.656737e-02 ,1.603647e-02 ,1.551727e-02 ,1.500886e-02 , &
       1.451045e-02 ,1.402132e-02 ,1.354084e-02 ,1.306842e-02 ,1.260355e-02 , &
       1.214575e-02 ,1.169460e-02 ,1.124971e-02 ,1.081072e-02 ,1.037731e-02 , &
       9.949167e-03 ,9.526021e-03 ,9.107615e-03 ,8.693714e-03 ,8.284096e-03 , &
       7.878558e-03 ,7.476910e-03 ,7.078974e-03 ,6.684586e-03 ,6.293589e-03 , &
       5.905839e-03 ,5.521200e-03 ,5.139543e-03 /)
      absice2(:,3) = (/ &
! band 3
       1.065397e-01 ,8.005726e-02 ,6.546428e-02 ,5.589131e-02 ,4.898681e-02 , &
       4.369932e-02 ,3.947901e-02 ,3.600676e-02 ,3.308299e-02 ,3.057561e-02 , &
       2.839325e-02 ,2.647040e-02 ,2.475872e-02 ,2.322164e-02 ,2.183091e-02 , &
       2.056430e-02 ,1.940407e-02 ,1.833586e-02 ,1.734787e-02 ,1.643034e-02 , &
       1.557512e-02 ,1.477530e-02 ,1.402501e-02 ,1.331924e-02 ,1.265364e-02 , &
       1.202445e-02 ,1.142838e-02 ,1.086257e-02 ,1.032445e-02 ,9.811791e-03 , &
       9.322587e-03 ,8.855053e-03 ,8.407591e-03 ,7.978763e-03 ,7.567273e-03 , &
       7.171949e-03 ,6.791728e-03 ,6.425642e-03 ,6.072809e-03 ,5.732424e-03 , &
       5.403748e-03 ,5.086103e-03 ,4.778865e-03 /)
      absice2(:,4) = (/ &
! band 4
       1.804566e-01 ,1.168987e-01 ,8.680442e-02 ,6.910060e-02 ,5.738174e-02 , &
       4.902332e-02 ,4.274585e-02 ,3.784923e-02 ,3.391734e-02 ,3.068690e-02 , &
       2.798301e-02 ,2.568480e-02 ,2.370600e-02 ,2.198337e-02 ,2.046940e-02 , &
       1.912777e-02 ,1.793016e-02 ,1.685420e-02 ,1.588193e-02 ,1.499882e-02 , &
       1.419293e-02 ,1.345440e-02 ,1.277496e-02 ,1.214769e-02 ,1.156669e-02 , &
       1.102694e-02 ,1.052412e-02 ,1.005451e-02 ,9.614854e-03 ,9.202335e-03 , &
       8.814470e-03 ,8.449077e-03 ,8.104223e-03 ,7.778195e-03 ,7.469466e-03 , &
       7.176671e-03 ,6.898588e-03 ,6.634117e-03 ,6.382264e-03 ,6.142134e-03 , &
       5.912913e-03 ,5.693862e-03 ,5.484308e-03 /)
      absice2(:,5) = (/ &
! band 5
       2.131806e-01 ,1.311372e-01 ,9.407171e-02 ,7.299442e-02 ,5.941273e-02 , &
       4.994043e-02 ,4.296242e-02 ,3.761113e-02 ,3.337910e-02 ,2.994978e-02 , &
       2.711556e-02 ,2.473461e-02 ,2.270681e-02 ,2.095943e-02 ,1.943839e-02 , &
       1.810267e-02 ,1.692057e-02 ,1.586719e-02 ,1.492275e-02 ,1.407132e-02 , &
       1.329989e-02 ,1.259780e-02 ,1.195618e-02 ,1.136761e-02 ,1.082583e-02 , &
       1.032552e-02 ,9.862158e-03 ,9.431827e-03 ,9.031157e-03 ,8.657217e-03 , &
       8.307449e-03 ,7.979609e-03 ,7.671724e-03 ,7.382048e-03 ,7.109032e-03 , &
       6.851298e-03 ,6.607615e-03 ,6.376881e-03 ,6.158105e-03 ,5.950394e-03 , &
       5.752942e-03 ,5.565019e-03 ,5.385963e-03 /)
      absice2(:,6) = (/ &
! band 6
       1.546177e-01 ,1.039251e-01 ,7.910347e-02 ,6.412429e-02 ,5.399997e-02 , &
       4.664937e-02 ,4.104237e-02 ,3.660781e-02 ,3.300218e-02 ,3.000586e-02 , &
       2.747148e-02 ,2.529633e-02 ,2.340647e-02 ,2.174723e-02 ,2.027731e-02 , &
       1.896487e-02 ,1.778492e-02 ,1.671761e-02 ,1.574692e-02 ,1.485978e-02 , &
       1.404543e-02 ,1.329489e-02 ,1.260066e-02 ,1.195636e-02 ,1.135657e-02 , &
       1.079664e-02 ,1.027257e-02 ,9.780871e-03 ,9.318505e-03 ,8.882815e-03 , &
       8.471458e-03 ,8.082364e-03 ,7.713696e-03 ,7.363817e-03 ,7.031264e-03 , &
       6.714725e-03 ,6.413021e-03 ,6.125086e-03 ,5.849958e-03 ,5.586764e-03 , &
       5.334707e-03 ,5.093066e-03 ,4.861179e-03 /)
      absice2(:,7) = (/ &
! band 7
       7.583404e-02 ,6.181558e-02 ,5.312027e-02 ,4.696039e-02 ,4.225986e-02 , &
       3.849735e-02 ,3.538340e-02 ,3.274182e-02 ,3.045798e-02 ,2.845343e-02 , &
       2.667231e-02 ,2.507353e-02 ,2.362606e-02 ,2.230595e-02 ,2.109435e-02 , &
       1.997617e-02 ,1.893916e-02 ,1.797328e-02 ,1.707016e-02 ,1.622279e-02 , &
       1.542523e-02 ,1.467241e-02 ,1.395997e-02 ,1.328414e-02 ,1.264164e-02 , &
       1.202958e-02 ,1.144544e-02 ,1.088697e-02 ,1.035218e-02 ,9.839297e-03 , &
       9.346733e-03 ,8.873057e-03 ,8.416980e-03 ,7.977335e-03 ,7.553066e-03 , &
       7.143210e-03 ,6.746888e-03 ,6.363297e-03 ,5.991700e-03 ,5.631422e-03 , &
       5.281840e-03 ,4.942378e-03 ,4.612505e-03 /)
      absice2(:,8) = (/ &
! band 8
       9.022185e-02 ,6.922700e-02 ,5.710674e-02 ,4.898377e-02 ,4.305946e-02 , &
       3.849553e-02 ,3.484183e-02 ,3.183220e-02 ,2.929794e-02 ,2.712627e-02 , &
       2.523856e-02 ,2.357810e-02 ,2.210286e-02 ,2.078089e-02 ,1.958747e-02 , &
       1.850310e-02 ,1.751218e-02 ,1.660205e-02 ,1.576232e-02 ,1.498440e-02 , &
       1.426107e-02 ,1.358624e-02 ,1.295474e-02 ,1.236212e-02 ,1.180456e-02 , &
       1.127874e-02 ,1.078175e-02 ,1.031106e-02 ,9.864433e-03 ,9.439878e-03 , &
       9.035637e-03 ,8.650140e-03 ,8.281981e-03 ,7.929895e-03 ,7.592746e-03 , &
       7.269505e-03 ,6.959238e-03 ,6.661100e-03 ,6.374317e-03 ,6.098185e-03 , &
       5.832059e-03 ,5.575347e-03 ,5.327504e-03 /)
      absice2(:,9) = (/ &
! band 9
       1.294087e-01 ,8.788217e-02 ,6.728288e-02 ,5.479720e-02 ,4.635049e-02 , &
       4.022253e-02 ,3.555576e-02 ,3.187259e-02 ,2.888498e-02 ,2.640843e-02 , &
       2.431904e-02 ,2.253038e-02 ,2.098024e-02 ,1.962267e-02 ,1.842293e-02 , &
       1.735426e-02 ,1.639571e-02 ,1.553060e-02 ,1.474552e-02 ,1.402953e-02 , &
       1.337363e-02 ,1.277033e-02 ,1.221336e-02 ,1.169741e-02 ,1.121797e-02 , &
       1.077117e-02 ,1.035369e-02 ,9.962643e-03 ,9.595509e-03 ,9.250088e-03 , &
       8.924447e-03 ,8.616876e-03 ,8.325862e-03 ,8.050057e-03 ,7.788258e-03 , &
       7.539388e-03 ,7.302478e-03 ,7.076656e-03 ,6.861134e-03 ,6.655197e-03 , &
       6.458197e-03 ,6.269543e-03 ,6.088697e-03 /)
      absice2(:,10) = (/ &
! band 10
       1.593628e-01 ,1.014552e-01 ,7.458955e-02 ,5.903571e-02 ,4.887582e-02 , &
       4.171159e-02 ,3.638480e-02 ,3.226692e-02 ,2.898717e-02 ,2.631256e-02 , &
       2.408925e-02 ,2.221156e-02 ,2.060448e-02 ,1.921325e-02 ,1.799699e-02 , &
       1.692456e-02 ,1.597177e-02 ,1.511961e-02 ,1.435289e-02 ,1.365933e-02 , &
       1.302890e-02 ,1.245334e-02 ,1.192576e-02 ,1.144037e-02 ,1.099230e-02 , &
       1.057739e-02 ,1.019208e-02 ,9.833302e-03 ,9.498395e-03 ,9.185047e-03 , &
       8.891237e-03 ,8.615185e-03 ,8.355325e-03 ,8.110267e-03 ,7.878778e-03 , &
       7.659759e-03 ,7.452224e-03 ,7.255291e-03 ,7.068166e-03 ,6.890130e-03 , &
       6.720536e-03 ,6.558794e-03 ,6.404371e-03 /)
      absice2(:,11) = (/ &
! band 11
       1.656227e-01 ,1.032129e-01 ,7.487359e-02 ,5.871431e-02 ,4.828355e-02 , &
       4.099989e-02 ,3.562924e-02 ,3.150755e-02 ,2.824593e-02 ,2.560156e-02 , &
       2.341503e-02 ,2.157740e-02 ,2.001169e-02 ,1.866199e-02 ,1.748669e-02 , &
       1.645421e-02 ,1.554015e-02 ,1.472535e-02 ,1.399457e-02 ,1.333553e-02 , &
       1.273821e-02 ,1.219440e-02 ,1.169725e-02 ,1.124104e-02 ,1.082096e-02 , &
       1.043290e-02 ,1.007336e-02 ,9.739338e-03 ,9.428223e-03 ,9.137756e-03 , &
       8.865964e-03 ,8.611115e-03 ,8.371686e-03 ,8.146330e-03 ,7.933852e-03 , &
       7.733187e-03 ,7.543386e-03 ,7.363597e-03 ,7.193056e-03 ,7.031072e-03 , &
       6.877024e-03 ,6.730348e-03 ,6.590531e-03 /)
      absice2(:,12) = (/ &
! band 12
       9.194591e-02 ,6.446867e-02 ,4.962034e-02 ,4.042061e-02 ,3.418456e-02 , &
       2.968856e-02 ,2.629900e-02 ,2.365572e-02 ,2.153915e-02 ,1.980791e-02 , &
       1.836689e-02 ,1.714979e-02 ,1.610900e-02 ,1.520946e-02 ,1.442476e-02 , &
       1.373468e-02 ,1.312345e-02 ,1.257858e-02 ,1.209010e-02 ,1.164990e-02 , &
       1.125136e-02 ,1.088901e-02 ,1.055827e-02 ,1.025531e-02 ,9.976896e-03 , &
       9.720255e-03 ,9.483022e-03 ,9.263160e-03 ,9.058902e-03 ,8.868710e-03 , &
       8.691240e-03 ,8.525312e-03 ,8.369886e-03 ,8.224042e-03 ,8.086961e-03 , &
       7.957917e-03 ,7.836258e-03 ,7.721400e-03 ,7.612821e-03 ,7.510045e-03 , &
       7.412648e-03 ,7.320242e-03 ,7.232476e-03 /)
      absice2(:,13) = (/ &
! band 13
       1.437021e-01 ,8.872535e-02 ,6.392420e-02 ,4.991833e-02 ,4.096790e-02 , &
       3.477881e-02 ,3.025782e-02 ,2.681909e-02 ,2.412102e-02 ,2.195132e-02 , &
       2.017124e-02 ,1.868641e-02 ,1.743044e-02 ,1.635529e-02 ,1.542540e-02 , &
       1.461388e-02 ,1.390003e-02 ,1.326766e-02 ,1.270395e-02 ,1.219860e-02 , &
       1.174326e-02 ,1.133107e-02 ,1.095637e-02 ,1.061442e-02 ,1.030126e-02 , &
       1.001352e-02 ,9.748340e-03 ,9.503256e-03 ,9.276155e-03 ,9.065205e-03 , &
       8.868808e-03 ,8.685571e-03 ,8.514268e-03 ,8.353820e-03 ,8.203272e-03 , &
       8.061776e-03 ,7.928578e-03 ,7.803001e-03 ,7.684443e-03 ,7.572358e-03 , &
       7.466258e-03 ,7.365701e-03 ,7.270286e-03 /)
      absice2(:,14) = (/ &
! band 14
       1.288870e-01 ,8.160295e-02 ,5.964745e-02 ,4.703790e-02 ,3.888637e-02 , &
       3.320115e-02 ,2.902017e-02 ,2.582259e-02 ,2.330224e-02 ,2.126754e-02 , &
       1.959258e-02 ,1.819130e-02 ,1.700289e-02 ,1.598320e-02 ,1.509942e-02 , &
       1.432666e-02 ,1.364572e-02 ,1.304156e-02 ,1.250220e-02 ,1.201803e-02 , &
       1.158123e-02 ,1.118537e-02 ,1.082513e-02 ,1.049605e-02 ,1.019440e-02 , &
       9.916989e-03 ,9.661116e-03 ,9.424457e-03 ,9.205005e-03 ,9.001022e-03 , &
       8.810992e-03 ,8.633588e-03 ,8.467646e-03 ,8.312137e-03 ,8.166151e-03 , &
       8.028878e-03 ,7.899597e-03 ,7.777663e-03 ,7.662498e-03 ,7.553581e-03 , &
       7.450444e-03 ,7.352662e-03 ,7.259851e-03 /)
      absice2(:,15) = (/ &
! band 15
       8.254229e-02 ,5.808787e-02 ,4.492166e-02 ,3.675028e-02 ,3.119623e-02 , &
       2.718045e-02 ,2.414450e-02 ,2.177073e-02 ,1.986526e-02 ,1.830306e-02 , &
       1.699991e-02 ,1.589698e-02 ,1.495199e-02 ,1.413374e-02 ,1.341870e-02 , &
       1.278883e-02 ,1.223002e-02 ,1.173114e-02 ,1.128322e-02 ,1.087900e-02 , &
       1.051254e-02 ,1.017890e-02 ,9.873991e-03 ,9.594347e-03 ,9.337044e-03 , &
       9.099589e-03 ,8.879842e-03 ,8.675960e-03 ,8.486341e-03 ,8.309594e-03 , &
       8.144500e-03 ,7.989986e-03 ,7.845109e-03 ,7.709031e-03 ,7.581007e-03 , &
       7.460376e-03 ,7.346544e-03 ,7.238978e-03 ,7.137201e-03 ,7.040780e-03 , &
       6.949325e-03 ,6.862483e-03 ,6.779931e-03 /)
      absice2(:,16) = (/ &
! band 16
       1.382062e-01 ,8.643227e-02 ,6.282935e-02 ,4.934783e-02 ,4.063891e-02 , &
       3.455591e-02 ,3.007059e-02 ,2.662897e-02 ,2.390631e-02 ,2.169972e-02 , &
       1.987596e-02 ,1.834393e-02 ,1.703924e-02 ,1.591513e-02 ,1.493679e-02 , &
       1.407780e-02 ,1.331775e-02 ,1.264061e-02 ,1.203364e-02 ,1.148655e-02 , &
       1.099099e-02 ,1.054006e-02 ,1.012807e-02 ,9.750215e-03 ,9.402477e-03 , &
       9.081428e-03 ,8.784143e-03 ,8.508107e-03 ,8.251146e-03 ,8.011373e-03 , &
       7.787140e-03 ,7.577002e-03 ,7.379687e-03 ,7.194071e-03 ,7.019158e-03 , &
       6.854061e-03 ,6.697986e-03 ,6.550224e-03 ,6.410138e-03 ,6.277153e-03 , &
       6.150751e-03 ,6.030462e-03 ,5.915860e-03 /)

! ICEFLAG = 3; Fu parameterization. Particle size 5 - 140 micron in 
! increments of 3 microns.
! units = m2/g
! Hexagonal Ice Particle Parameterization
! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)]
      absice3(:,1) = (/ &
! band 1
       3.110649e-03 ,4.666352e-02 ,6.606447e-02 ,6.531678e-02 ,6.012598e-02 , &
       5.437494e-02 ,4.906411e-02 ,4.441146e-02 ,4.040585e-02 ,3.697334e-02 , &
       3.403027e-02 ,3.149979e-02 ,2.931596e-02 ,2.742365e-02 ,2.577721e-02 , &
       2.433888e-02 ,2.307732e-02 ,2.196644e-02 ,2.098437e-02 ,2.011264e-02 , &
       1.933561e-02 ,1.863992e-02 ,1.801407e-02 ,1.744812e-02 ,1.693346e-02 , &
       1.646252e-02 ,1.602866e-02 ,1.562600e-02 ,1.524933e-02 ,1.489399e-02 , &
       1.455580e-02 ,1.423098e-02 ,1.391612e-02 ,1.360812e-02 ,1.330413e-02 , &
       1.300156e-02 ,1.269801e-02 ,1.239127e-02 ,1.207928e-02 ,1.176014e-02 , &
       1.143204e-02 ,1.109334e-02 ,1.074243e-02 ,1.037786e-02 ,9.998198e-03 , &
       9.602126e-03 /)
      absice3(:,2) = (/ &
! band 2
       3.984966e-04 ,1.681097e-02 ,2.627680e-02 ,2.767465e-02 ,2.700722e-02 , &
       2.579180e-02 ,2.448677e-02 ,2.323890e-02 ,2.209096e-02 ,2.104882e-02 , &
       2.010547e-02 ,1.925003e-02 ,1.847128e-02 ,1.775883e-02 ,1.710358e-02 , &
       1.649769e-02 ,1.593449e-02 ,1.540829e-02 ,1.491429e-02 ,1.444837e-02 , &
       1.400704e-02 ,1.358729e-02 ,1.318654e-02 ,1.280258e-02 ,1.243346e-02 , &
       1.207750e-02 ,1.173325e-02 ,1.139941e-02 ,1.107487e-02 ,1.075861e-02 , &
       1.044975e-02 ,1.014753e-02 ,9.851229e-03 ,9.560240e-03 ,9.274003e-03 , &
       8.992020e-03 ,8.713845e-03 ,8.439074e-03 ,8.167346e-03 ,7.898331e-03 , &
       7.631734e-03 ,7.367286e-03 ,7.104742e-03 ,6.843882e-03 ,6.584504e-03 , &
       6.326424e-03 /)
      absice3(:,3) = (/ &
! band 3
       6.933163e-02 ,8.540475e-02 ,7.701816e-02 ,6.771158e-02 ,5.986953e-02 , &
       5.348120e-02 ,4.824962e-02 ,4.390563e-02 ,4.024411e-02 ,3.711404e-02 , &
       3.440426e-02 ,3.203200e-02 ,2.993478e-02 ,2.806474e-02 ,2.638464e-02 , &
       2.486516e-02 ,2.348288e-02 ,2.221890e-02 ,2.105780e-02 ,1.998687e-02 , &
       1.899552e-02 ,1.807490e-02 ,1.721750e-02 ,1.641693e-02 ,1.566773e-02 , &
       1.496515e-02 ,1.430509e-02 ,1.368398e-02 ,1.309865e-02 ,1.254634e-02 , &
       1.202456e-02 ,1.153114e-02 ,1.106409e-02 ,1.062166e-02 ,1.020224e-02 , &
       9.804381e-03 ,9.426771e-03 ,9.068205e-03 ,8.727578e-03 ,8.403876e-03 , &
       8.096160e-03 ,7.803564e-03 ,7.525281e-03 ,7.260560e-03 ,7.008697e-03 , &
       6.769036e-03 /)
      absice3(:,4) = (/ &
! band 4
       1.765735e-01 ,1.382700e-01 ,1.095129e-01 ,8.987475e-02 ,7.591185e-02 , &
       6.554169e-02 ,5.755500e-02 ,5.122083e-02 ,4.607610e-02 ,4.181475e-02 , &
       3.822697e-02 ,3.516432e-02 ,3.251897e-02 ,3.021073e-02 ,2.817876e-02 , &
       2.637607e-02 ,2.476582e-02 ,2.331871e-02 ,2.201113e-02 ,2.082388e-02 , &
       1.974115e-02 ,1.874983e-02 ,1.783894e-02 ,1.699922e-02 ,1.622280e-02 , &
       1.550296e-02 ,1.483390e-02 ,1.421064e-02 ,1.362880e-02 ,1.308460e-02 , &
       1.257468e-02 ,1.209611e-02 ,1.164628e-02 ,1.122287e-02 ,1.082381e-02 , &
       1.044725e-02 ,1.009154e-02 ,9.755166e-03 ,9.436783e-03 ,9.135163e-03 , &
       8.849193e-03 ,8.577856e-03 ,8.320225e-03 ,8.075451e-03 ,7.842755e-03 , &
       7.621418e-03 /)
      absice3(:,5) = (/ &
! band 5
       2.339673e-01 ,1.692124e-01 ,1.291656e-01 ,1.033837e-01 ,8.562949e-02 , &
       7.273526e-02 ,6.298262e-02 ,5.537015e-02 ,4.927787e-02 ,4.430246e-02 , &
       4.017061e-02 ,3.669072e-02 ,3.372455e-02 ,3.116995e-02 ,2.894977e-02 , &
       2.700471e-02 ,2.528842e-02 ,2.376420e-02 ,2.240256e-02 ,2.117959e-02 , &
       2.007567e-02 ,1.907456e-02 ,1.816271e-02 ,1.732874e-02 ,1.656300e-02 , &
       1.585725e-02 ,1.520445e-02 ,1.459852e-02 ,1.403419e-02 ,1.350689e-02 , &
       1.301260e-02 ,1.254781e-02 ,1.210941e-02 ,1.169468e-02 ,1.130118e-02 , &
       1.092675e-02 ,1.056945e-02 ,1.022757e-02 ,9.899560e-03 ,9.584021e-03 , &
       9.279705e-03 ,8.985479e-03 ,8.700322e-03 ,8.423306e-03 ,8.153590e-03 , &
       7.890412e-03 /)
      absice3(:,6) = (/ &
! band 6
       1.145369e-01 ,1.174566e-01 ,9.917866e-02 ,8.332990e-02 ,7.104263e-02 , &
       6.153370e-02 ,5.405472e-02 ,4.806281e-02 ,4.317918e-02 ,3.913795e-02 , &
       3.574916e-02 ,3.287437e-02 ,3.041067e-02 ,2.828017e-02 ,2.642292e-02 , &
       2.479206e-02 ,2.335051e-02 ,2.206851e-02 ,2.092195e-02 ,1.989108e-02 , &
       1.895958e-02 ,1.811385e-02 ,1.734245e-02 ,1.663573e-02 ,1.598545e-02 , &
       1.538456e-02 ,1.482700e-02 ,1.430750e-02 ,1.382150e-02 ,1.336499e-02 , &
       1.293447e-02 ,1.252685e-02 ,1.213939e-02 ,1.176968e-02 ,1.141555e-02 , &
       1.107508e-02 ,1.074655e-02 ,1.042839e-02 ,1.011923e-02 ,9.817799e-03 , &
       9.522962e-03 ,9.233688e-03 ,8.949041e-03 ,8.668171e-03 ,8.390301e-03 , &
       8.114723e-03 /)
      absice3(:,7) = (/ &
! band 7
       1.222345e-02 ,5.344230e-02 ,5.523465e-02 ,5.128759e-02 ,4.676925e-02 , &
       4.266150e-02 ,3.910561e-02 ,3.605479e-02 ,3.342843e-02 ,3.115052e-02 , &
       2.915776e-02 ,2.739935e-02 ,2.583499e-02 ,2.443266e-02 ,2.316681e-02 , &
       2.201687e-02 ,2.096619e-02 ,2.000112e-02 ,1.911044e-02 ,1.828481e-02 , &
       1.751641e-02 ,1.679866e-02 ,1.612598e-02 ,1.549360e-02 ,1.489742e-02 , &
       1.433392e-02 ,1.380002e-02 ,1.329305e-02 ,1.281068e-02 ,1.235084e-02 , &
       1.191172e-02 ,1.149171e-02 ,1.108936e-02 ,1.070341e-02 ,1.033271e-02 , &
       9.976220e-03 ,9.633021e-03 ,9.302273e-03 ,8.983216e-03 ,8.675161e-03 , &
       8.377478e-03 ,8.089595e-03 ,7.810986e-03 ,7.541170e-03 ,7.279706e-03 , &
       7.026186e-03 /)
      absice3(:,8) = (/ &
! band 8
       6.711058e-02 ,6.918198e-02 ,6.127484e-02 ,5.411944e-02 ,4.836902e-02 , &
       4.375293e-02 ,3.998077e-02 ,3.683587e-02 ,3.416508e-02 ,3.186003e-02 , &
       2.984290e-02 ,2.805671e-02 ,2.645895e-02 ,2.501733e-02 ,2.370689e-02 , &
       2.250808e-02 ,2.140532e-02 ,2.038609e-02 ,1.944018e-02 ,1.855918e-02 , &
       1.773609e-02 ,1.696504e-02 ,1.624106e-02 ,1.555990e-02 ,1.491793e-02 , &
       1.431197e-02 ,1.373928e-02 ,1.319743e-02 ,1.268430e-02 ,1.219799e-02 , &
       1.173682e-02 ,1.129925e-02 ,1.088393e-02 ,1.048961e-02 ,1.011516e-02 , &
       9.759543e-03 ,9.421813e-03 ,9.101089e-03 ,8.796559e-03 ,8.507464e-03 , &
       8.233098e-03 ,7.972798e-03 ,7.725942e-03 ,7.491940e-03 ,7.270238e-03 , &
       7.060305e-03 /)
      absice3(:,9) = (/ &
! band 9
       1.236780e-01 ,9.222386e-02 ,7.383997e-02 ,6.204072e-02 ,5.381029e-02 , &
       4.770678e-02 ,4.296928e-02 ,3.916131e-02 ,3.601540e-02 ,3.335878e-02 , &
       3.107493e-02 ,2.908247e-02 ,2.732282e-02 ,2.575276e-02 ,2.433968e-02 , &
       2.305852e-02 ,2.188966e-02 ,2.081757e-02 ,1.982974e-02 ,1.891599e-02 , &
       1.806794e-02 ,1.727865e-02 ,1.654227e-02 ,1.585387e-02 ,1.520924e-02 , &
       1.460476e-02 ,1.403730e-02 ,1.350416e-02 ,1.300293e-02 ,1.253153e-02 , &
       1.208808e-02 ,1.167094e-02 ,1.127862e-02 ,1.090979e-02 ,1.056323e-02 , &
       1.023786e-02 ,9.932665e-03 ,9.646744e-03 ,9.379250e-03 ,9.129409e-03 , &
       8.896500e-03 ,8.679856e-03 ,8.478852e-03 ,8.292904e-03 ,8.121463e-03 , &
       7.964013e-03 /)
      absice3(:,10) = (/ &
! band 10
       1.655966e-01 ,1.134205e-01 ,8.714344e-02 ,7.129241e-02 ,6.063739e-02 , &
       5.294203e-02 ,4.709309e-02 ,4.247476e-02 ,3.871892e-02 ,3.559206e-02 , &
       3.293893e-02 ,3.065226e-02 ,2.865558e-02 ,2.689288e-02 ,2.532221e-02 , &
       2.391150e-02 ,2.263582e-02 ,2.147549e-02 ,2.041476e-02 ,1.944089e-02 , &
       1.854342e-02 ,1.771371e-02 ,1.694456e-02 ,1.622989e-02 ,1.556456e-02 , &
       1.494415e-02 ,1.436491e-02 ,1.382354e-02 ,1.331719e-02 ,1.284339e-02 , &
       1.239992e-02 ,1.198486e-02 ,1.159647e-02 ,1.123323e-02 ,1.089375e-02 , &
       1.057679e-02 ,1.028124e-02 ,1.000607e-02 ,9.750376e-03 ,9.513303e-03 , &
       9.294082e-03 ,9.092003e-03 ,8.906412e-03 ,8.736702e-03 ,8.582314e-03 , &
       8.442725e-03 /)
      absice3(:,11) = (/ &
! band 11
       1.775615e-01 ,1.180046e-01 ,8.929607e-02 ,7.233500e-02 ,6.108333e-02 , &
       5.303642e-02 ,4.696927e-02 ,4.221206e-02 ,3.836768e-02 ,3.518576e-02 , &
       3.250063e-02 ,3.019825e-02 ,2.819758e-02 ,2.643943e-02 ,2.487953e-02 , &
       2.348414e-02 ,2.222705e-02 ,2.108762e-02 ,2.004936e-02 ,1.909892e-02 , &
       1.822539e-02 ,1.741975e-02 ,1.667449e-02 ,1.598330e-02 ,1.534084e-02 , &
       1.474253e-02 ,1.418446e-02 ,1.366325e-02 ,1.317597e-02 ,1.272004e-02 , &
       1.229321e-02 ,1.189350e-02 ,1.151915e-02 ,1.116859e-02 ,1.084042e-02 , &
       1.053338e-02 ,1.024636e-02 ,9.978326e-03 ,9.728357e-03 ,9.495613e-03 , &
       9.279327e-03 ,9.078798e-03 ,8.893383e-03 ,8.722488e-03 ,8.565568e-03 , &
       8.422115e-03 /)
      absice3(:,12) = (/ &
! band 12
       9.465447e-02 ,6.432047e-02 ,5.060973e-02 ,4.267283e-02 ,3.741843e-02 , &
       3.363096e-02 ,3.073531e-02 ,2.842405e-02 ,2.651789e-02 ,2.490518e-02 , &
       2.351273e-02 ,2.229056e-02 ,2.120335e-02 ,2.022541e-02 ,1.933763e-02 , &
       1.852546e-02 ,1.777763e-02 ,1.708528e-02 ,1.644134e-02 ,1.584009e-02 , &
       1.527684e-02 ,1.474774e-02 ,1.424955e-02 ,1.377957e-02 ,1.333549e-02 , &
       1.291534e-02 ,1.251743e-02 ,1.214029e-02 ,1.178265e-02 ,1.144337e-02 , &
       1.112148e-02 ,1.081609e-02 ,1.052642e-02 ,1.025178e-02 ,9.991540e-03 , &
       9.745130e-03 ,9.512038e-03 ,9.291797e-03 ,9.083980e-03 ,8.888195e-03 , &
       8.704081e-03 ,8.531306e-03 ,8.369560e-03 ,8.218558e-03 ,8.078032e-03 , &
       7.947730e-03 /)
      absice3(:,13) = (/ &
! band 13
       1.560311e-01 ,9.961097e-02 ,7.502949e-02 ,6.115022e-02 ,5.214952e-02 , &
       4.578149e-02 ,4.099731e-02 ,3.724174e-02 ,3.419343e-02 ,3.165356e-02 , &
       2.949251e-02 ,2.762222e-02 ,2.598073e-02 ,2.452322e-02 ,2.321642e-02 , &
       2.203516e-02 ,2.096002e-02 ,1.997579e-02 ,1.907036e-02 ,1.823401e-02 , &
       1.745879e-02 ,1.673819e-02 ,1.606678e-02 ,1.544003e-02 ,1.485411e-02 , &
       1.430574e-02 ,1.379215e-02 ,1.331092e-02 ,1.285996e-02 ,1.243746e-02 , &
       1.204183e-02 ,1.167164e-02 ,1.132567e-02 ,1.100281e-02 ,1.070207e-02 , &
       1.042258e-02 ,1.016352e-02 ,9.924197e-03 ,9.703953e-03 ,9.502199e-03 , &
       9.318400e-03 ,9.152066e-03 ,9.002749e-03 ,8.870038e-03 ,8.753555e-03 , &
       8.652951e-03 /)
      absice3(:,14) = (/ &
! band 14
       1.559547e-01 ,9.896700e-02 ,7.441231e-02 ,6.061469e-02 ,5.168730e-02 , &
       4.537821e-02 ,4.064106e-02 ,3.692367e-02 ,3.390714e-02 ,3.139438e-02 , &
       2.925702e-02 ,2.740783e-02 ,2.578547e-02 ,2.434552e-02 ,2.305506e-02 , &
       2.188910e-02 ,2.082842e-02 ,1.985789e-02 ,1.896553e-02 ,1.814165e-02 , &
       1.737839e-02 ,1.666927e-02 ,1.600891e-02 ,1.539279e-02 ,1.481712e-02 , &
       1.427865e-02 ,1.377463e-02 ,1.330266e-02 ,1.286068e-02 ,1.244689e-02 , &
       1.205973e-02 ,1.169780e-02 ,1.135989e-02 ,1.104492e-02 ,1.075192e-02 , &
       1.048004e-02 ,1.022850e-02 ,9.996611e-03 ,9.783753e-03 ,9.589361e-03 , &
       9.412924e-03 ,9.253977e-03 ,9.112098e-03 ,8.986903e-03 ,8.878039e-03 , &
       8.785184e-03 /)
      absice3(:,15) = (/ &
! band 15
       1.102926e-01 ,7.176622e-02 ,5.530316e-02 ,4.606056e-02 ,4.006116e-02 , &
       3.579628e-02 ,3.256909e-02 ,3.001360e-02 ,2.791920e-02 ,2.615617e-02 , &
       2.464023e-02 ,2.331426e-02 ,2.213817e-02 ,2.108301e-02 ,2.012733e-02 , &
       1.925493e-02 ,1.845331e-02 ,1.771269e-02 ,1.702531e-02 ,1.638493e-02 , &
       1.578648e-02 ,1.522579e-02 ,1.469940e-02 ,1.420442e-02 ,1.373841e-02 , &
       1.329931e-02 ,1.288535e-02 ,1.249502e-02 ,1.212700e-02 ,1.178015e-02 , &
       1.145348e-02 ,1.114612e-02 ,1.085730e-02 ,1.058633e-02 ,1.033263e-02 , &
       1.009564e-02 ,9.874895e-03 ,9.669960e-03 ,9.480449e-03 ,9.306014e-03 , &
       9.146339e-03 ,9.001138e-03 ,8.870154e-03 ,8.753148e-03 ,8.649907e-03 , &
       8.560232e-03 /)
      absice3(:,16) = (/ &
! band 16
       1.688344e-01 ,1.077072e-01 ,7.994467e-02 ,6.403862e-02 ,5.369850e-02 , &
       4.641582e-02 ,4.099331e-02 ,3.678724e-02 ,3.342069e-02 ,3.065831e-02 , &
       2.834557e-02 ,2.637680e-02 ,2.467733e-02 ,2.319286e-02 ,2.188299e-02 , &
       2.071701e-02 ,1.967121e-02 ,1.872692e-02 ,1.786931e-02 ,1.708641e-02 , &
       1.636846e-02 ,1.570743e-02 ,1.509665e-02 ,1.453052e-02 ,1.400433e-02 , &
       1.351407e-02 ,1.305631e-02 ,1.262810e-02 ,1.222688e-02 ,1.185044e-02 , &
       1.149683e-02 ,1.116436e-02 ,1.085153e-02 ,1.055701e-02 ,1.027961e-02 , &
       1.001831e-02 ,9.772141e-03 ,9.540280e-03 ,9.321966e-03 ,9.116517e-03 , &
       8.923315e-03 ,8.741803e-03 ,8.571472e-03 ,8.411860e-03 ,8.262543e-03 , &
       8.123136e-03 /)

! For LIQFLAG = 0.
      absliq0 = 0.0903614 

! For LIQFLAG = 1.  In each band, the absorption
! coefficients are listed for a range of effective radii from 2.5
! to 59.5 microns in increments of 1.0 micron.
      absliq1(:, 1) = (/ &
! band  1
       1.64047e-03 , 6.90533e-02 , 7.72017e-02 , 7.78054e-02 , 7.69523e-02 , &
       7.58058e-02 , 7.46400e-02 , 7.35123e-02 , 7.24162e-02 , 7.13225e-02 , &
       6.99145e-02 , 6.66409e-02 , 6.36582e-02 , 6.09425e-02 , 5.84593e-02 , &
       5.61743e-02 , 5.40571e-02 , 5.20812e-02 , 5.02245e-02 , 4.84680e-02 , &
       4.67959e-02 , 4.51944e-02 , 4.36516e-02 , 4.21570e-02 , 4.07015e-02 , &
       3.92766e-02 , 3.78747e-02 , 3.64886e-02 , 3.53632e-02 , 3.41992e-02 , &
       3.31016e-02 , 3.20643e-02 , 3.10817e-02 , 3.01490e-02 , 2.92620e-02 , &
       2.84171e-02 , 2.76108e-02 , 2.68404e-02 , 2.61031e-02 , 2.53966e-02 , &
       2.47189e-02 , 2.40678e-02 , 2.34418e-02 , 2.28392e-02 , 2.22586e-02 , &
       2.16986e-02 , 2.11580e-02 , 2.06356e-02 , 2.01305e-02 , 1.96417e-02 , &
       1.91682e-02 , 1.87094e-02 , 1.82643e-02 , 1.78324e-02 , 1.74129e-02 , &
       1.70052e-02 , 1.66088e-02 , 1.62231e-02 /)
      absliq1(:, 2) = (/ &
! band  2
       2.19486e-01 , 1.80687e-01 , 1.59150e-01 , 1.44731e-01 , 1.33703e-01 , &
       1.24355e-01 , 1.15756e-01 , 1.07318e-01 , 9.86119e-02 , 8.92739e-02 , &
       8.34911e-02 , 7.70773e-02 , 7.15240e-02 , 6.66615e-02 , 6.23641e-02 , &
       5.85359e-02 , 5.51020e-02 , 5.20032e-02 , 4.91916e-02 , 4.66283e-02 , &
       4.42813e-02 , 4.21236e-02 , 4.01330e-02 , 3.82905e-02 , 3.65797e-02 , &
       3.49869e-02 , 3.35002e-02 , 3.21090e-02 , 3.08957e-02 , 2.97601e-02 , &
       2.86966e-02 , 2.76984e-02 , 2.67599e-02 , 2.58758e-02 , 2.50416e-02 , &
       2.42532e-02 , 2.35070e-02 , 2.27997e-02 , 2.21284e-02 , 2.14904e-02 , &
       2.08834e-02 , 2.03051e-02 , 1.97536e-02 , 1.92271e-02 , 1.87239e-02 , &
       1.82425e-02 , 1.77816e-02 , 1.73399e-02 , 1.69162e-02 , 1.65094e-02 , &
       1.61187e-02 , 1.57430e-02 , 1.53815e-02 , 1.50334e-02 , 1.46981e-02 , &
       1.43748e-02 , 1.40628e-02 , 1.37617e-02 /)
      absliq1(:, 3) = (/ &
! band  3
       2.95174e-01 , 2.34765e-01 , 1.98038e-01 , 1.72114e-01 , 1.52083e-01 , &
       1.35654e-01 , 1.21613e-01 , 1.09252e-01 , 9.81263e-02 , 8.79448e-02 , &
       8.12566e-02 , 7.44563e-02 , 6.86374e-02 , 6.36042e-02 , 5.92094e-02 , &
       5.53402e-02 , 5.19087e-02 , 4.88455e-02 , 4.60951e-02 , 4.36124e-02 , &
       4.13607e-02 , 3.93096e-02 , 3.74338e-02 , 3.57119e-02 , 3.41261e-02 , &
       3.26610e-02 , 3.13036e-02 , 3.00425e-02 , 2.88497e-02 , 2.78077e-02 , &
       2.68317e-02 , 2.59158e-02 , 2.50545e-02 , 2.42430e-02 , 2.34772e-02 , &
       2.27533e-02 , 2.20679e-02 , 2.14181e-02 , 2.08011e-02 , 2.02145e-02 , &
       1.96561e-02 , 1.91239e-02 , 1.86161e-02 , 1.81311e-02 , 1.76673e-02 , &
       1.72234e-02 , 1.67981e-02 , 1.63903e-02 , 1.59989e-02 , 1.56230e-02 , &
       1.52615e-02 , 1.49138e-02 , 1.45791e-02 , 1.42565e-02 , 1.39455e-02 , &
       1.36455e-02 , 1.33559e-02 , 1.30761e-02 /)
      absliq1(:, 4) = (/ &
! band  4
       3.00925e-01 , 2.36949e-01 , 1.96947e-01 , 1.68692e-01 , 1.47190e-01 , &
       1.29986e-01 , 1.15719e-01 , 1.03568e-01 , 9.30028e-02 , 8.36658e-02 , &
       7.71075e-02 , 7.07002e-02 , 6.52284e-02 , 6.05024e-02 , 5.63801e-02 , &
       5.27534e-02 , 4.95384e-02 , 4.66690e-02 , 4.40925e-02 , 4.17664e-02 , &
       3.96559e-02 , 3.77326e-02 , 3.59727e-02 , 3.43561e-02 , 3.28662e-02 , &
       3.14885e-02 , 3.02110e-02 , 2.90231e-02 , 2.78948e-02 , 2.69109e-02 , &
       2.59884e-02 , 2.51217e-02 , 2.43058e-02 , 2.35364e-02 , 2.28096e-02 , &
       2.21218e-02 , 2.14700e-02 , 2.08515e-02 , 2.02636e-02 , 1.97041e-02 , &
       1.91711e-02 , 1.86625e-02 , 1.81769e-02 , 1.77126e-02 , 1.72683e-02 , &
       1.68426e-02 , 1.64344e-02 , 1.60427e-02 , 1.56664e-02 , 1.53046e-02 , &
       1.49565e-02 , 1.46214e-02 , 1.42985e-02 , 1.39871e-02 , 1.36866e-02 , &
       1.33965e-02 , 1.31162e-02 , 1.28453e-02 /)
      absliq1(:, 5) = (/ &
! band  5
       2.64691e-01 , 2.12018e-01 , 1.78009e-01 , 1.53539e-01 , 1.34721e-01 , &
       1.19580e-01 , 1.06996e-01 , 9.62772e-02 , 8.69710e-02 , 7.87670e-02 , &
       7.29272e-02 , 6.70920e-02 , 6.20977e-02 , 5.77732e-02 , 5.39910e-02 , &
       5.06538e-02 , 4.76866e-02 , 4.50301e-02 , 4.26374e-02 , 4.04704e-02 , &
       3.84981e-02 , 3.66948e-02 , 3.50394e-02 , 3.35141e-02 , 3.21038e-02 , &
       3.07957e-02 , 2.95788e-02 , 2.84438e-02 , 2.73790e-02 , 2.64390e-02 , &
       2.55565e-02 , 2.47263e-02 , 2.39437e-02 , 2.32047e-02 , 2.25056e-02 , &
       2.18433e-02 , 2.12149e-02 , 2.06177e-02 , 2.00495e-02 , 1.95081e-02 , &
       1.89917e-02 , 1.84984e-02 , 1.80269e-02 , 1.75755e-02 , 1.71431e-02 , &
       1.67283e-02 , 1.63303e-02 , 1.59478e-02 , 1.55801e-02 , 1.52262e-02 , &
       1.48853e-02 , 1.45568e-02 , 1.42400e-02 , 1.39342e-02 , 1.36388e-02 , &
       1.33533e-02 , 1.30773e-02 , 1.28102e-02 /)
      absliq1(:, 6) = (/ &
! band  6
       8.81182e-02 , 1.06745e-01 , 9.79753e-02 , 8.99625e-02 , 8.35200e-02 , &
       7.81899e-02 , 7.35939e-02 , 6.94696e-02 , 6.56266e-02 , 6.19148e-02 , &
       5.83355e-02 , 5.49306e-02 , 5.19642e-02 , 4.93325e-02 , 4.69659e-02 , &
       4.48148e-02 , 4.28431e-02 , 4.10231e-02 , 3.93332e-02 , 3.77563e-02 , &
       3.62785e-02 , 3.48882e-02 , 3.35758e-02 , 3.23333e-02 , 3.11536e-02 , &
       3.00310e-02 , 2.89601e-02 , 2.79365e-02 , 2.70502e-02 , 2.62618e-02 , &
       2.55025e-02 , 2.47728e-02 , 2.40726e-02 , 2.34013e-02 , 2.27583e-02 , &
       2.21422e-02 , 2.15522e-02 , 2.09869e-02 , 2.04453e-02 , 1.99260e-02 , &
       1.94280e-02 , 1.89501e-02 , 1.84913e-02 , 1.80506e-02 , 1.76270e-02 , &
       1.72196e-02 , 1.68276e-02 , 1.64500e-02 , 1.60863e-02 , 1.57357e-02 , &
       1.53975e-02 , 1.50710e-02 , 1.47558e-02 , 1.44511e-02 , 1.41566e-02 , &
       1.38717e-02 , 1.35960e-02 , 1.33290e-02 /)
      absliq1(:, 7) = (/ &
! band  7
       4.32174e-02 , 7.36078e-02 , 6.98340e-02 , 6.65231e-02 , 6.41948e-02 , &
       6.23551e-02 , 6.06638e-02 , 5.88680e-02 , 5.67124e-02 , 5.38629e-02 , &
       4.99579e-02 , 4.86289e-02 , 4.70120e-02 , 4.52854e-02 , 4.35466e-02 , &
       4.18480e-02 , 4.02169e-02 , 3.86658e-02 , 3.71992e-02 , 3.58168e-02 , &
       3.45155e-02 , 3.32912e-02 , 3.21390e-02 , 3.10538e-02 , 3.00307e-02 , &
       2.90651e-02 , 2.81524e-02 , 2.72885e-02 , 2.62821e-02 , 2.55744e-02 , &
       2.48799e-02 , 2.42029e-02 , 2.35460e-02 , 2.29108e-02 , 2.22981e-02 , &
       2.17079e-02 , 2.11402e-02 , 2.05945e-02 , 2.00701e-02 , 1.95663e-02 , &
       1.90824e-02 , 1.86174e-02 , 1.81706e-02 , 1.77411e-02 , 1.73281e-02 , &
       1.69307e-02 , 1.65483e-02 , 1.61801e-02 , 1.58254e-02 , 1.54835e-02 , &
       1.51538e-02 , 1.48358e-02 , 1.45288e-02 , 1.42322e-02 , 1.39457e-02 , &
       1.36687e-02 , 1.34008e-02 , 1.31416e-02 /)
      absliq1(:, 8) = (/ &
! band  8
       1.41881e-01 , 7.15419e-02 , 6.30335e-02 , 6.11132e-02 , 6.01931e-02 , &
       5.92420e-02 , 5.78968e-02 , 5.58876e-02 , 5.28923e-02 , 4.84462e-02 , &
       4.60839e-02 , 4.56013e-02 , 4.45410e-02 , 4.31866e-02 , 4.17026e-02 , &
       4.01850e-02 , 3.86892e-02 , 3.72461e-02 , 3.58722e-02 , 3.45749e-02 , &
       3.33564e-02 , 3.22155e-02 , 3.11494e-02 , 3.01541e-02 , 2.92253e-02 , &
       2.83584e-02 , 2.75488e-02 , 2.67925e-02 , 2.57692e-02 , 2.50704e-02 , &
       2.43918e-02 , 2.37350e-02 , 2.31005e-02 , 2.24888e-02 , 2.18996e-02 , &
       2.13325e-02 , 2.07870e-02 , 2.02623e-02 , 1.97577e-02 , 1.92724e-02 , &
       1.88056e-02 , 1.83564e-02 , 1.79241e-02 , 1.75079e-02 , 1.71070e-02 , &
       1.67207e-02 , 1.63482e-02 , 1.59890e-02 , 1.56424e-02 , 1.53077e-02 , &
       1.49845e-02 , 1.46722e-02 , 1.43702e-02 , 1.40782e-02 , 1.37955e-02 , &
       1.35219e-02 , 1.32569e-02 , 1.30000e-02 /)
      absliq1(:, 9) = (/ &
! band  9
       6.72726e-02 , 6.61013e-02 , 6.47866e-02 , 6.33780e-02 , 6.18985e-02 , &
       6.03335e-02 , 5.86136e-02 , 5.65876e-02 , 5.39839e-02 , 5.03536e-02 , &
       4.71608e-02 , 4.63630e-02 , 4.50313e-02 , 4.34526e-02 , 4.17876e-02 , &
       4.01261e-02 , 3.85171e-02 , 3.69860e-02 , 3.55442e-02 , 3.41954e-02 , &
       3.29384e-02 , 3.17693e-02 , 3.06832e-02 , 2.96745e-02 , 2.87374e-02 , &
       2.78662e-02 , 2.70557e-02 , 2.63008e-02 , 2.52450e-02 , 2.45424e-02 , &
       2.38656e-02 , 2.32144e-02 , 2.25885e-02 , 2.19873e-02 , 2.14099e-02 , &
       2.08554e-02 , 2.03230e-02 , 1.98116e-02 , 1.93203e-02 , 1.88482e-02 , &
       1.83944e-02 , 1.79578e-02 , 1.75378e-02 , 1.71335e-02 , 1.67440e-02 , &
       1.63687e-02 , 1.60069e-02 , 1.56579e-02 , 1.53210e-02 , 1.49958e-02 , &
       1.46815e-02 , 1.43778e-02 , 1.40841e-02 , 1.37999e-02 , 1.35249e-02 , &
       1.32585e-02 , 1.30004e-02 , 1.27502e-02 /)
      absliq1(:,10) = (/ &
! band 10
       7.97040e-02 , 7.63844e-02 , 7.36499e-02 , 7.13525e-02 , 6.93043e-02 , &
       6.72807e-02 , 6.50227e-02 , 6.22395e-02 , 5.86093e-02 , 5.37815e-02 , &
       5.14682e-02 , 4.97214e-02 , 4.77392e-02 , 4.56961e-02 , 4.36858e-02 , &
       4.17569e-02 , 3.99328e-02 , 3.82224e-02 , 3.66265e-02 , 3.51416e-02 , &
       3.37617e-02 , 3.24798e-02 , 3.12887e-02 , 3.01812e-02 , 2.91505e-02 , &
       2.81900e-02 , 2.72939e-02 , 2.64568e-02 , 2.54165e-02 , 2.46832e-02 , &
       2.39783e-02 , 2.33017e-02 , 2.26531e-02 , 2.20314e-02 , 2.14359e-02 , &
       2.08653e-02 , 2.03187e-02 , 1.97947e-02 , 1.92924e-02 , 1.88106e-02 , &
       1.83483e-02 , 1.79043e-02 , 1.74778e-02 , 1.70678e-02 , 1.66735e-02 , &
       1.62941e-02 , 1.59286e-02 , 1.55766e-02 , 1.52371e-02 , 1.49097e-02 , &
       1.45937e-02 , 1.42885e-02 , 1.39936e-02 , 1.37085e-02 , 1.34327e-02 , &
       1.31659e-02 , 1.29075e-02 , 1.26571e-02 /)
      absliq1(:,11) = (/ &
! band 11
       1.49438e-01 , 1.33535e-01 , 1.21542e-01 , 1.11743e-01 , 1.03263e-01 , &
       9.55774e-02 , 8.83382e-02 , 8.12943e-02 , 7.42533e-02 , 6.70609e-02 , &
       6.38761e-02 , 5.97788e-02 , 5.59841e-02 , 5.25318e-02 , 4.94132e-02 , &
       4.66014e-02 , 4.40644e-02 , 4.17706e-02 , 3.96910e-02 , 3.77998e-02 , &
       3.60742e-02 , 3.44947e-02 , 3.30442e-02 , 3.17079e-02 , 3.04730e-02 , &
       2.93283e-02 , 2.82642e-02 , 2.72720e-02 , 2.61789e-02 , 2.53277e-02 , &
       2.45237e-02 , 2.37635e-02 , 2.30438e-02 , 2.23615e-02 , 2.17140e-02 , &
       2.10987e-02 , 2.05133e-02 , 1.99557e-02 , 1.94241e-02 , 1.89166e-02 , &
       1.84317e-02 , 1.79679e-02 , 1.75238e-02 , 1.70983e-02 , 1.66901e-02 , &
       1.62983e-02 , 1.59219e-02 , 1.55599e-02 , 1.52115e-02 , 1.48761e-02 , &
       1.45528e-02 , 1.42411e-02 , 1.39402e-02 , 1.36497e-02 , 1.33690e-02 , &
       1.30976e-02 , 1.28351e-02 , 1.25810e-02 /)
      absliq1(:,12) = (/ &
! band 12
       3.71985e-02 , 3.88586e-02 , 3.99070e-02 , 4.04351e-02 , 4.04610e-02 , &
       3.99834e-02 , 3.89953e-02 , 3.74886e-02 , 3.54551e-02 , 3.28870e-02 , &
       3.32576e-02 , 3.22444e-02 , 3.12384e-02 , 3.02584e-02 , 2.93146e-02 , &
       2.84120e-02 , 2.75525e-02 , 2.67361e-02 , 2.59618e-02 , 2.52280e-02 , &
       2.45327e-02 , 2.38736e-02 , 2.32487e-02 , 2.26558e-02 , 2.20929e-02 , &
       2.15579e-02 , 2.10491e-02 , 2.05648e-02 , 1.99749e-02 , 1.95704e-02 , &
       1.91731e-02 , 1.87839e-02 , 1.84032e-02 , 1.80315e-02 , 1.76689e-02 , &
       1.73155e-02 , 1.69712e-02 , 1.66362e-02 , 1.63101e-02 , 1.59928e-02 , &
       1.56842e-02 , 1.53840e-02 , 1.50920e-02 , 1.48080e-02 , 1.45318e-02 , &
       1.42631e-02 , 1.40016e-02 , 1.37472e-02 , 1.34996e-02 , 1.32586e-02 , &
       1.30239e-02 , 1.27954e-02 , 1.25728e-02 , 1.23559e-02 , 1.21445e-02 , &
       1.19385e-02 , 1.17376e-02 , 1.15417e-02 /)
      absliq1(:,13) = (/ &
! band 13
       3.11868e-02 , 4.48357e-02 , 4.90224e-02 , 4.96406e-02 , 4.86806e-02 , &
       4.69610e-02 , 4.48630e-02 , 4.25795e-02 , 4.02138e-02 , 3.78236e-02 , &
       3.74266e-02 , 3.60384e-02 , 3.47074e-02 , 3.34434e-02 , 3.22499e-02 , &
       3.11264e-02 , 3.00704e-02 , 2.90784e-02 , 2.81463e-02 , 2.72702e-02 , &
       2.64460e-02 , 2.56698e-02 , 2.49381e-02 , 2.42475e-02 , 2.35948e-02 , &
       2.29774e-02 , 2.23925e-02 , 2.18379e-02 , 2.11793e-02 , 2.07076e-02 , &
       2.02470e-02 , 1.97981e-02 , 1.93613e-02 , 1.89367e-02 , 1.85243e-02 , &
       1.81240e-02 , 1.77356e-02 , 1.73588e-02 , 1.69935e-02 , 1.66392e-02 , &
       1.62956e-02 , 1.59624e-02 , 1.56393e-02 , 1.53259e-02 , 1.50219e-02 , &
       1.47268e-02 , 1.44404e-02 , 1.41624e-02 , 1.38925e-02 , 1.36302e-02 , &
       1.33755e-02 , 1.31278e-02 , 1.28871e-02 , 1.26530e-02 , 1.24253e-02 , &
       1.22038e-02 , 1.19881e-02 , 1.17782e-02 /)
      absliq1(:,14) = (/ &
! band 14
       1.58988e-02 , 3.50652e-02 , 4.00851e-02 , 4.07270e-02 , 3.98101e-02 , &
       3.83306e-02 , 3.66829e-02 , 3.50327e-02 , 3.34497e-02 , 3.19609e-02 , &
       3.13712e-02 , 3.03348e-02 , 2.93415e-02 , 2.83973e-02 , 2.75037e-02 , &
       2.66604e-02 , 2.58654e-02 , 2.51161e-02 , 2.44100e-02 , 2.37440e-02 , &
       2.31154e-02 , 2.25215e-02 , 2.19599e-02 , 2.14282e-02 , 2.09242e-02 , &
       2.04459e-02 , 1.99915e-02 , 1.95594e-02 , 1.90254e-02 , 1.86598e-02 , &
       1.82996e-02 , 1.79455e-02 , 1.75983e-02 , 1.72584e-02 , 1.69260e-02 , &
       1.66013e-02 , 1.62843e-02 , 1.59752e-02 , 1.56737e-02 , 1.53799e-02 , &
       1.50936e-02 , 1.48146e-02 , 1.45429e-02 , 1.42782e-02 , 1.40203e-02 , &
       1.37691e-02 , 1.35243e-02 , 1.32858e-02 , 1.30534e-02 , 1.28270e-02 , &
       1.26062e-02 , 1.23909e-02 , 1.21810e-02 , 1.19763e-02 , 1.17766e-02 , &
       1.15817e-02 , 1.13915e-02 , 1.12058e-02 /)
      absliq1(:,15) = (/ &
! band 15
       5.02079e-03 , 2.17615e-02 , 2.55449e-02 , 2.59484e-02 , 2.53650e-02 , &
       2.45281e-02 , 2.36843e-02 , 2.29159e-02 , 2.22451e-02 , 2.16716e-02 , &
       2.11451e-02 , 2.05817e-02 , 2.00454e-02 , 1.95372e-02 , 1.90567e-02 , &
       1.86028e-02 , 1.81742e-02 , 1.77693e-02 , 1.73866e-02 , 1.70244e-02 , &
       1.66815e-02 , 1.63563e-02 , 1.60477e-02 , 1.57544e-02 , 1.54755e-02 , &
       1.52097e-02 , 1.49564e-02 , 1.47146e-02 , 1.43684e-02 , 1.41728e-02 , &
       1.39762e-02 , 1.37797e-02 , 1.35838e-02 , 1.33891e-02 , 1.31961e-02 , &
       1.30051e-02 , 1.28164e-02 , 1.26302e-02 , 1.24466e-02 , 1.22659e-02 , &
       1.20881e-02 , 1.19131e-02 , 1.17412e-02 , 1.15723e-02 , 1.14063e-02 , &
       1.12434e-02 , 1.10834e-02 , 1.09264e-02 , 1.07722e-02 , 1.06210e-02 , &
       1.04725e-02 , 1.03269e-02 , 1.01839e-02 , 1.00436e-02 , 9.90593e-03 , &
       9.77080e-03 , 9.63818e-03 , 9.50800e-03 /)
      absliq1(:,16) = (/ &
! band 16
       5.64971e-02 , 9.04736e-02 , 8.11726e-02 , 7.05450e-02 , 6.20052e-02 , &
       5.54286e-02 , 5.03503e-02 , 4.63791e-02 , 4.32290e-02 , 4.06959e-02 , &
       3.74690e-02 , 3.52964e-02 , 3.33799e-02 , 3.16774e-02 , 3.01550e-02 , &
       2.87856e-02 , 2.75474e-02 , 2.64223e-02 , 2.53953e-02 , 2.44542e-02 , &
       2.35885e-02 , 2.27894e-02 , 2.20494e-02 , 2.13622e-02 , 2.07222e-02 , &
       2.01246e-02 , 1.95654e-02 , 1.90408e-02 , 1.84398e-02 , 1.80021e-02 , &
       1.75816e-02 , 1.71775e-02 , 1.67889e-02 , 1.64152e-02 , 1.60554e-02 , &
       1.57089e-02 , 1.53751e-02 , 1.50531e-02 , 1.47426e-02 , 1.44428e-02 , &
       1.41532e-02 , 1.38734e-02 , 1.36028e-02 , 1.33410e-02 , 1.30875e-02 , &
       1.28420e-02 , 1.26041e-02 , 1.23735e-02 , 1.21497e-02 , 1.19325e-02 , &
       1.17216e-02 , 1.15168e-02 , 1.13177e-02 , 1.11241e-02 , 1.09358e-02 , &
       1.07525e-02 , 1.05741e-02 , 1.04003e-02 /)

      end subroutine lwcldpr

      end module rrtmg_lw_init_f


      module rrtmg_lw_rad_f 1,10

!  --------------------------------------------------------------------------
! |                                                                          |
! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
! |  This software may be used, copied, or redistributed as long as it is    |
! |  not sold and this copyright notice is reproduced on each copy made.     |
! |  This model is provided as is without any express or implied warranties. |
! |                       (http://www.rtweb.aer.com/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------
!

#ifdef _ACCEL
      use cudafor
#endif

      use gpu_mcica_subcol_gen_lw

      use gpu_rrtmg_lw_rtrnmc
      use gpu_rrtmg_lw_setcoef
      use gpu_rrtmg_lw_cldprmc
    
      use gpu_rrtmg_lw_taumol, only: taumolg, copyGPUTaumol
      use rrlw_cld_f, only: abscld1, absliq0, absliq1, &
                          absice0, absice1, absice2, absice3
      use rrlw_wvn_f, only: ngb, ngs
      use rrlw_tbl_f, only: tblint, bpade, tau_tbl, exp_tbl, tfn_tbl, ntbl
      use rrlw_con_f, only: fluxfac, heatfac, oneminus, pi, grav, avogad
      use rrlw_vsn_f  

      implicit none

#ifdef _ACCEL
      integer  _gpudev, allocatable :: ngbd(:)
      integer, allocatable _gpudev :: ncbandsd(:)
      integer, allocatable _gpudev :: icbd(:)
      integer, allocatable _gpudev :: icldlyr(:,:)
      real  _gpudev, allocatable :: fracsd(:,:,:)
      real  _gpudev, allocatable :: taug(:,:,:)
!$OMP THREADPRIVATE(ngbd,ncbandsd,icbd,icldlyr,fracsd,taug)
#endif
   
      real :: timings(10)
      INTEGER, PARAMETER :: debug_level_lwf=100

!------------------------------------------------------------------
      contains
!------------------------------------------------------------------

      subroutine rrtmg_lw( & 2,18
             ncol    ,nlay    ,icld    ,idrv    , &
             play    ,plev    ,tlay    ,tlev    ,tsfc    , & 
             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr  ,o2vmr , &
             cfc11vmr,cfc12vmr,cfc22vmr,ccl4vmr ,emis    , &
             inflglw ,iceflglw,liqflglw,cldfrac , &
             tauc    ,ciwp    ,clwp    ,cswp    ,rei     ,rel   , res , &
             tauaer  , &
             uflx    ,dflx    ,hr      ,uflxc   ,dflxc   ,hrc , &
             duflx_dt,duflxc_dt)
! -------- Description --------

! This program is the driver subroutine for RRTMG_LW, the AER LW radiation 
! model for application to GCMs, that has been adapted from RRTM_LW for
! improved efficiency.
!
! NOTE: The call to RRTMG_LW_INI should be moved to the GCM initialization
!  area, since this has to be called only once. 
!
! This routine:
!    a) calls INATM to read in the atmospheric profile from GCM;
!       all layering in RRTMG is ordered from surface to toa. 
!    b) calls CLDPRMC to set cloud optical depth for McICA based 
!       on input cloud properties 
!    c) calls SETCOEF to calculate various quantities needed for 
!       the radiative transfer algorithm
!    d) calls TAUMOL to calculate gaseous optical depths for each 
!       of the 16 spectral bands
!    e) calls RTRNMC (for both clear and cloudy profiles) to perform the
!       radiative transfer calculation using McICA, the Monte-Carlo 
!       Independent Column Approximation, to represent sub-grid scale 
!       cloud variability
!    f) passes the necessary fluxes and cooling rates back to GCM
!
! Two modes of operation are possible:
!     The mode is chosen by using either rrtmg_lw.nomcica.f90 (to not use
!     McICA) or rrtmg_lw.f90 (to use McICA) to interface with a GCM. 
!
!    1) Standard, single forward model calculation (imca = 0)
!    2) Monte Carlo Independent Column Approximation (McICA, Pincus et al., 
!       JC, 2003) method is applied to the forward model calculation (imca = 1)
!
! This call to RRTMG_LW must be preceeded by a call to the module
!     mcica_subcol_gen_lw.f90 to run the McICA sub-column cloud generator,
!     which will provide the cloud physical or cloud optical properties
!     on the RRTMG quadrature point (ngpt) dimension.
!     Two random number generators are available for use when imca = 1.
!     This is chosen by setting flag irnd on input to mcica_subcol_gen_lw.
!     1) KISSVEC (irnd = 0)
!     2) Mersenne-Twister (irnd = 1)
!
! Two methods of cloud property input are possible:
!     Cloud properties can be input in one of two ways (controlled by input 
!     flags inflglw, iceflglw, and liqflglw; see text file rrtmg_lw_instructions
!     and subroutine rrtmg_lw_cldprmc.f90 for further details):
!
!    1) Input cloud fraction and cloud optical depth directly (inflglw = 0)
!    2) Input cloud fraction and cloud physical properties (inflglw = 1 or 2);  
!       cloud optical properties are calculated by cldprmc or cldprmc based
!       on input settings of iceflglw and liqflglw.  Ice particle size provided
!       must be appropriately defined for the ice parameterization selected. 
!
! One method of aerosol property input is possible:
!     Aerosol properties can be input in only one way (controlled by input 
!     flag iaer; see text file rrtmg_lw_instructions for further details):
!
!    1) Input aerosol optical depth directly by layer and spectral band (iaer=10);
!       band average optical depth at the mid-point of each spectral band.
!       RRTMG_LW currently treats only aerosol absorption;
!       scattering capability is not presently available.
!
! The optional calculation of the change in upward flux as a function of surface 
! temperature is available (controlled by input flag idrv).  This can be utilized 
! to approximate adjustments to the upward flux profile caused only by a change in 
! surface temperature between full radiation calls.  This feature uses the pre-
! calculated derivative of the Planck function with respect to surface temperature. 
!
!    1) Normal forward calculation for the input profile (idrv=0)
!    2) Normal forward calculation with optional calculation of the change
!       in upward flux as a function of surface temperature for clear sky
!       and total sky flux.  Flux partial derivatives are provided in arrays
!       duflx_dt and duflxc_dt for total and clear sky.  (idrv=1)
!
!
! ------- Modifications -------
!
! This version of RRTMG_LW has been modified from RRTM_LW to use a reduced 
! set of g-points for application to GCMs.  
!
!-- Original version (derived from RRTM_LW), reduction of g-points, other
!   revisions for use with GCMs.  
!     1999: M. J. Iacono, AER, Inc.
!-- Adapted for use with NCAR/CAM.
!     May 2004: M. J. Iacono, AER, Inc.
!-- Revised to add McICA capability. 
!     Nov 2005: M. J. Iacono, AER, Inc.
!-- Conversion to F90 formatting for consistency with rrtmg_sw.
!     Feb 2007: M. J. Iacono, AER, Inc.
!-- Modifications to formatting to use assumed-shape arrays.
!     Aug 2007: M. J. Iacono, AER, Inc.
!-- Modified to add longwave aerosol absorption.
!     Apr 2008: M. J. Iacono, AER, Inc.
!-- Added capability to calculate derivative of upward flux wrt surface temperature. 
!     Nov 2009: M. J. Iacono, E. J. Mlawer, AER, Inc.
!-- Added capability to run on GPU
!     Aug 2012: David Berthiaume, AER, Inc.
! --------- Modules ----------

      use parrrtm_f, only : nbndlw, ngptlw, maxxsec, mxmol, mxlay, nbndlw
      use rrlw_con_f, only: fluxfac, heatfac, oneminus, pi
      use rrlw_wvn_f, only: ng, ngb, nspa, nspb, wavenum1, wavenum2, delwave

! ------- Declarations -------

         ! integer , parameter:: maxlay = 203
         ! integer , parameter:: mxmol = 38
          

! ----- Input -----
! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol) 
      integer , intent(in) :: ncol                    ! Number of horizontal columns
      integer , intent(in) :: nlay                    ! Number of model layers
      integer , intent(inout) :: icld                 ! Cloud overlap method
                                                      !    0: Clear only
                                                      !    1: Random
                                                      !    2: Maximum/random
                                                      !    3: Maximum
                                                      !    4: Exponential (inactive)
      integer , intent(in) :: idrv                    ! Flag for calculation of dFdT, the change
                                                      !    in upward flux as a function of 
                                                      !    surface temperature [0=off, 1=on]
                                                      !    0: Normal forward calculation
                                                      !    1: Normal forward calculation with
                                                      !       duflx_dt and duflxc_dt output

!      integer , intent(in) :: cloudMH, cloudHH        ! cloud layer heights for cloudFlag
      real , intent(in) :: play(:,:)                  ! Layer pressures (hPa, mb)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: plev(:,0:)                 ! Interface pressures (hPa, mb)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: tlay(:,:)                  ! Layer temperatures (K)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: tlev(:,0:)                 ! Interface temperatures (K)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: tsfc(:)                    ! Surface temperature (K)
                                                      !    Dimensions: (ncol)
      real , intent(in) :: h2ovmr(:,:)                ! H2O volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: o3vmr(:,:)                 ! O3 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: co2vmr(:,:)                ! CO2 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: ch4vmr(:,:)                ! Methane volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: n2ovmr(:,:)                ! Nitrous oxide volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: o2vmr(:,:)                 ! Oxygen volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cfc11vmr(:, :)             ! CFC11 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cfc12vmr(:, :)             ! CFC12 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cfc22vmr(:, :)             ! CFC22 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: ccl4vmr(:, :)              ! CCL4 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: emis(:, :)                 ! Surface emissivity
                                                      !    Dimensions: (ncol,nbndlw)

      integer , intent(in) :: inflglw                 ! Flag for cloud optical properties
      integer , intent(in) :: iceflglw                ! Flag for ice particle specification
      integer , intent(in) :: liqflglw                ! Flag for liquid droplet specification

      real , intent(in) :: cldfrac(:,:)               ! Cloud fraction
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: ciwp(:,:)                  ! In-cloud ice water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: clwp(:,:)                  ! In-cloud liquid water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cswp(:,:)                  ! In-cloud snow water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: rei(:,:)                   ! Cloud ice particle effective size (microns)
                                                      !    Dimensions: (ncol,nlay)
                                                      ! specific definition of reicmcl depends on setting of iceflglw:
                                                      ! iceflglw = 0: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !               r_ec must be >= 10.0 microns
                                                      ! iceflglw = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !               r_ec range is limited to 13.0 to 130.0 microns
                                                      ! iceflglw = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
                                                      !               r_k range is limited to 5.0 to 131.0 microns
                                                      ! iceflglw = 3: generalized effective size, dge, (Fu, 1996),
                                                      !               dge range is limited to 5.0 to 140.0 microns
                                                      !               [dge = 1.0315 * r_ec]
      real , intent(in) :: rel(:, :)                  ! Cloud water drop effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: res(:, :)                  ! Cloud snow effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: tauc(:, :, :)              ! In-cloud optical depth
                                                      !    Dimensions: (ncol,nbndlw,nlay)
      real , intent(in) :: tauaer(:,:,:)              ! aerosol optical depth
                                                      !   at mid-point of LW spectral bands
                                                      !    Dimensions: (ncol,nlay,nbndlw)

! ----- Output -----

      real , intent(out) :: uflx(:,:)                 ! Total sky longwave upward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: dflx(:,:)                 ! Total sky longwave downward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: hr(:,:)                   ! Total sky longwave radiative heating rate (K/d)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(out) :: uflxc(:,:)                ! Clear sky longwave upward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: dflxc(:,:)                ! Clear sky longwave downward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: hrc(:,:)                  ! Clear sky longwave radiative heating rate (K/d)
                                                      !    Dimensions: (ncol,nlay)

! ----- Optional Output -----
      real , intent(out), optional :: duflx_dt(:,:)     
                                                      ! change in upward longwave flux (w/m2/K)
                                                      ! with respect to surface temperature
                                                      !    Dimensions: (ncol,nlay)
      real , intent(out), optional :: duflxc_dt(:,:)    
                                                      ! change in clear sky upward longwave flux (w/m2/K)
                                                      ! with respect to surface temperature
                                                      !    Dimensions: (ncol,nlay)
!      integer , intent(out), optional :: cloudFlag(:,:)
      
      real,  pointer :: alp(:,:)

      integer  :: pncol
      integer  :: colstart
      integer  :: cn, ns, i, np, mns
      real :: minmem
      integer :: hetflag
      integer :: numDevices, err
    
      integer :: numThreads
integer,external :: omp_get_thread_num
      CHARACTER(LEN=256) :: message

      ! Cuda device information
#ifdef _ACCEL
      type(cudadeviceprop) :: prop
#endif
      ! store the available device global and constant memory
      real gmem, cmem
! mji - time      
      real t1,t2

!jm write(0,*)__FILE__,__LINE__,omp_get_thread_num()
#ifdef _ACCEL
 
      err = cudaGetDeviceProperties( prop, 0)
      gmem = prop%totalGlobalMem
!      print *, "total GPU global memory is ", gmem / (1024.0*1024.0) , "MB"
 
#endif
      
! (dmb 2012) Here we calculate the number of groups to partition
! the inputs.

! determine the minimum GPU memory
! force the GPUFlag off if there are no devices available
      
#ifdef _ACCEL
      minmem = gmem        
#else

! on the CPU partiion the inputs into 2 GB chunks.  Runtime
! is pretty constant on the CPU as a function of the number
! of steps, so we pick a quantity that uses a relatively low
! amount of CPU memory.
      minmem = 2.0 * (1024.0**3)
         
! set the number of 'devices' to the available number of CPUs
#endif
!      print *, "available working memory is ", int(minmem / (1024*1024)) , " MB"
    
#ifdef _ACCEL
! use the available memory to determine the minumum number 
! of steps that will be required.
! We use 1500 profiles per available GB as a conservative 
! lower bound.
      cn = minmem * 1500 / (1024**3)

! with device emulation (for debugging) make sure there is a lower
! limit to the number of supported columns
      if (cn < 500) then 
        cn = 500 
      end if
! Set number of columns per partition to be no larger than total number of columns
      if (cn > ncol) then 
        cn = ncol
      end if
#else
      cn = CHNK
#endif
!
      WRITE(message,*)'RRTMG_LWF: Number of columns is               ',ncol
      call wrf_debug( debug_level_lwf, message)
      WRITE(message,*)'RRTMG_LWF: Number of columns per partition is ',cn
      call wrf_debug( debug_level_lwf, message)
      ns = ceiling( real(ncol) / real(cn) )
      WRITE(message,*)'RRTMG_LWF: Number of partitions is            ',ns
      call wrf_debug( debug_level_lwf, message)

! mji - time      
      call cpu_time(t1)

      do  i = 1, ns 

!jm if ( i .eq. IDEBUG_BASE ) then
!jm call setdebug
!jm else 
!jm call unsetdebug
!jm endif



      call rrtmg_lw_part &
            (ns, ncol, (i-1)*cn + 1, min(cn, ncol - (i-1)*cn), &
             nlay    ,icld    ,idrv,&
             play    ,plev    ,tlay    ,tlev    ,tsfc    , & 
             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr  ,o2vmr , &
             cfc11vmr,cfc12vmr,cfc22vmr,ccl4vmr ,emis    , &
             inflglw ,iceflglw,liqflglw,cldfrac , &
             tauc ,ciwp ,clwp ,cswp ,rei ,rel ,res , &
             tauaer  , &
             uflx    ,dflx    ,hr      ,uflxc   ,dflxc,  hrc, &
             duflx_dt,duflxc_dt)    
      end do  
      
! mji - time      
      call cpu_time(t2)
      WRITE(message,*)'------------------------------------------------'
      call wrf_debug( debug_level_lwf, message)
      WRITE(message,*)'TOTAL RRTMG_LWF RUN TIME IS   ', t2-t1
      call wrf_debug( debug_level_lwf, message)
      WRITE(message,*)'------------------------------------------------'
      call wrf_debug( debug_level_lwf, message)

      end subroutine


      subroutine rrtmg_lw_part & 1,25
            (npart, ncol , colstart, pncol , &
             nlay    ,icld    ,idrv    , &
             play    ,plev    ,tlay    ,tlev    ,tsfc    , & 
             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr  ,o2vmr , &
             cfc11vmr,cfc12vmr,cfc22vmr,ccl4vmr ,emis    , &
             inflglw ,iceflglw,liqflglw,cldfrac , &
             tauc ,ciwp ,clwp ,cswp ,rei ,rel ,res , &
             tauaer  , &
             uflx    ,dflx    ,hr      ,uflxc   ,dflxc,  hrc, &
             duflx_dt,duflxc_dt)
   
      use gpu_mcica_subcol_gen_lw, only: mcica_subcol_lwg, generate_stochastic_cloudsg
   
      use parrrtm_f, only : nbndlw, ngptlw, maxxsec, mxmol, mxlay, nbndlw, nmol
      use rrlw_con_f, only: fluxfac, heatfac, oneminus, pi
      use rrlw_wvn_f, only: ng, ngb, nspa, nspb, wavenum1, wavenum2, delwave, ixindx


! ----- Input -----
! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol) 
      integer , intent(in) :: npart
      integer , intent(in) :: ncol                    ! Number of horizontal columns
      integer , intent(in) :: nlay                    ! Number of model layers
      integer , intent(inout) :: icld                 ! Cloud overlap method
                                                      !    0: Clear only
                                                      !    1: Random
                                                      !    2: Maximum/random
                                                      !    3: Maximum
                                                      !    4: Exponential (inactive)
      integer , intent(in) :: idrv                    ! Flag for calculation of dFdT, the change
                                                      !    in upward flux as a function of 
                                                      !    surface temperature [0=off, 1=on]
                                                      !    0: Normal forward calculation
                                                      !    1: Normal forward calculation with
                                                      !       duflx_dt and duflxc_dt output

      real , intent(in) :: play(:,:)                  ! Layer pressures (hPa, mb)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: plev(:,0:)                 ! Interface pressures (hPa, mb)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: tlay(:,:)                  ! Layer temperatures (K)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: tlev(:,0:)                 ! Interface temperatures (K)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: tsfc(:)                    ! Surface temperature (K)
                                                      !    Dimensions: (ncol)
      real , intent(in) :: h2ovmr(:,:)                ! H2O volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: o3vmr(:,:)                 ! O3 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: co2vmr(:,:)                ! CO2 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: ch4vmr(:,:)                ! Methane volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: n2ovmr(:,:)                ! Nitrous oxide volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: o2vmr(:,:)                 ! Oxygen volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cfc11vmr(:, :)             ! CFC11 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cfc12vmr(:, :)             ! CFC12 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cfc22vmr(:, :)             ! CFC22 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: ccl4vmr(:, :)              ! CCL4 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: emis(:, :)                 ! Surface emissivity
                                                      !    Dimensions: (ncol,nbndlw)

      integer , intent(in) :: inflglw                 ! Flag for cloud optical properties
      integer , intent(in) :: iceflglw                ! Flag for ice particle specification
      integer , intent(in) :: liqflglw                ! Flag for liquid droplet specification

      real , intent(in) :: cldfrac(:,:)               ! Cloud fraction
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real , intent(in) :: ciwp(:,:)                  ! In-cloud ice water path (g/m2)
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real , intent(in) :: clwp(:,:)                  ! In-cloud liquid water path (g/m2)
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real , intent(in) :: cswp(:,:)                  ! In-cloud snow water path (g/m2)
                                                      !    Dimensions: (ngptlw,ncol,nlay)
      real , intent(in) :: rei(:,:)                   ! Cloud ice particle effective size (microns)
                                                      !    Dimensions: (ncol,nlay)
                                                      ! specific definition of reicmcl depends on setting of iceflglw:
                                                      ! iceflglw = 0: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !               r_ec must be >= 10.0 microns
                                                      ! iceflglw = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
                                                      !               r_ec range is limited to 13.0 to 130.0 microns
                                                      ! iceflglw = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
                                                      !               r_k range is limited to 5.0 to 131.0 microns
                                                      ! iceflglw = 3: generalized effective size, dge, (Fu, 1996),
                                                      !               dge range is limited to 5.0 to 140.0 microns
                                                      !               [dge = 1.0315 * r_ec]
      real , intent(in) :: rel(:, :)                  ! Cloud water drop effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: res(:, :)                  ! Cloud snow effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: tauc(:, :,:)               ! In-cloud optical depth
                                                      !    Dimensions: (ncol,nbndlw,nlay)

      real , intent(in) :: tauaer(:,:,:)              ! aerosol optical depth
                                                      !   at mid-point of LW spectral bands
                                                      !    Dimensions: (ncol,nlay,nbndlw)

      integer , intent(in) :: pncol
      integer , intent(in) :: colstart

#ifndef _ACCEL
# define pncol CHNK
#endif