!!MODULE module_ra_rrtmg_swf
#define CHNK 8
!#define CHNK 1849
!#define CHNK 43
!#define CHNK 1

!  --------------------------------------------------------------------------
! |                                                                          |
! |  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/)                        |
! |                                                                          |
!  --------------------------------------------------------------------------

#ifndef _ACCEL
! this set of macros reverses the storage order of some of the array variables
! defined in rrtmg_sw_sub and used in various sections of the code.  Here is a 
! correspondencet table for the variables as they are known in rrtmg_sw_sub and
! in the subroutines that rrtmg_sw_sub calls:

!jm     rrtmg_sw_sub    
!jm      |        mcica_sw        
!jm      |         |            cldprmc_sw      
!jm      |         |                |     spcvmc_sw       
!jm      |         |                |       |       reftra_sw
!jm     tauc      tauc              |       |         |   
!jm     ssac      ssac              |       |         |   
!jm     asmc      asmc              |       |         |   
!jm     fsfc      fsfc              |       |         |   
!jm     taucmc    tauc_stoch        |     ptaucmc     |
!jm     taormc     |                |     ptaormc     |
!jm     ssacmc    ssac_stoch        |     pomgcmc     |
!jm     asmcmc    asmc_stoch        |     pasycmc     |
!jm     fsfcmc    fsfc_stoch        |       |         |           
!jm     cldfmcl   cld_stoch       cldmfc  pcldfmc   pcldfmc
!jm     ciwpmcl   ciwp_stoch      ciwpmc    |     
!jm     clwpmcl   clwp_stoch      clwpmc    |     
!jm     cswpmcl   cswp_stoch      cswpmc    |     
!jm     ztauc                               |
!jm     ztaucorig                           |     
!jm     zasyc                               |
!jm     zomgc                               |
!jm     taua                              ptaua   
!jm     asya                              pasya   
!jm     omga                              pomga   

#define tauc(A,B,C)  TAUC(A,C,B)
#define ssac(A,B,C)  SSAC(A,C,B)
#define asmc(A,B,C)  ASMC(A,C,B)
#define fsfc(A,B,C)  FSFC(A,C,B)
#define taucmc(A,B,C)   TAUCMC(A,C,B)
#define tauc_stoch(A,B,C) TAUC_STOCH(A,C,B)
#define ptaucmc(A,B,C)  pTAUCMC(A,C,B)
#define taormc(A,B,C)   TAORMC(A,C,B)
#define ptaormc(A,B,C)  pTAORMC(A,C,B)
#define ssacmc(A,B,C)   SSACMC(A,C,B)
#define ssac_stoch(A,B,C)   SSAC_STOCH(A,C,B)
#define pomgcmc(A,B,C)  pOMGCMC(A,C,B)
#define asmcmc(A,B,C)   ASMCMC(A,C,B)
#define asmc_stoch(A,B,C)   ASMC_STOCH(A,C,B)
#define pasycmc(A,B,C)  pASYCMC(A,C,B)
#define fsfcmc(A,B,C)   FSFCMC(A,C,B)
#define fsfc_stoch(A,B,C)   FSFC_STOCH(A,C,B)

#define cldfmcl(A,B,C)   CLDFMCL(A,C,B)
#define cld_stoch(A,B,C) CLD_STOCH(A,C,B)
#define cldfmc(A,B,C)    CLDFMC(A,C,B)
#define pcldfmc(A,B,C)   pCLDFMC(A,C,B)

#define ciwpmcl(A,B,C)    CIWPMCL(A,C,B)
#define ciwp_stoch(A,B,C) CIWP_STOCH(A,C,B)
#define ciwpmc(A,B,C)     CIWPMC(A,C,B)

#define clwpmcl(A,B,C)    CLWPMCL(A,C,B)
#define clwp_stoch(A,B,C) CLWP_STOCH(A,C,B)
#define clwpmc(A,B,C)     CLWPMC(A,C,B)

#define cswpmcl(A,B,C)    CSWPMCL(A,C,B)
#define cswp_stoch(A,B,C) CSWP_STOCH(A,C,B)
#define cswpmc(A,B,C)     CSWPMC(A,C,B)

#define taua(A,B,C)  TAUA(A,C,B)
#define asya(A,B,C)  ASYA(A,C,B)
#define omga(A,B,C)  OMGA(A,C,B)
#define ptaua(A,B,C) pTAUA(A,C,B)
#define pasya(A,B,C) pASYA(A,C,B)
#define pomga(A,B,C) pOMGA(A,C,B)

#endif

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

#ifdef _ACCEL
#define gpu_device ,device
#else
#define gpu_device 
#endif

      module parrrsw_f

!     implicit none
      save

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

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! mxlay  :  integer: maximum number of layers
! mg     :  integer: number of original g-intervals per spectral band
! nbndsw :  integer: number of spectral bands
! naerec :  integer: number of aerosols (iaer=6, ecmwf aerosol option)
! ngptsw :  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  = 203   !jplay, klev
      integer , parameter :: mg     = 16     !jpg
      integer , parameter :: nbndsw = 14     !jpsw, ksw
      integer , parameter :: naerec  = 6     !jpaer
      integer , parameter :: mxmol  = 38
      integer , parameter :: nstr   = 2
      integer , parameter :: nmol   = 7
! Use for 112 g-point model   
      integer , parameter :: ngptsw = 112    !jpgpt
! Use for 224 g-point model   
!      integer , parameter :: ngptsw = 224   !jpgpt

! may need to rename these - from v2.6
      integer , parameter :: jpband   = 29
      integer , parameter :: jpb1     = 16   !istart
      integer , parameter :: jpb2     = 29   !iend

      integer , parameter :: jmcmu    = 32
      integer , parameter :: jmumu    = 32
      integer , parameter :: jmphi    = 3
      integer , parameter :: jmxang   = 4
      integer , parameter :: jmxstr   = 16
! ^

! Use for 112 g-point model   
      integer , parameter :: ng16 = 6
      integer , parameter :: ng17 = 12
      integer , parameter :: ng18 = 8
      integer , parameter :: ng19 = 8
      integer , parameter :: ng20 = 10
      integer , parameter :: ng21 = 10
      integer , parameter :: ng22 = 2
      integer , parameter :: ng23 = 10
      integer , parameter :: ng24 = 8
      integer , parameter :: ng25 = 6
      integer , parameter :: ng26 = 6
      integer , parameter :: ng27 = 8
      integer , parameter :: ng28 = 6
      integer , parameter :: ng29 = 12

      integer , parameter :: ngs16 = 6
      integer , parameter :: ngs17 = 18
      integer , parameter :: ngs18 = 26
      integer , parameter :: ngs19 = 34
      integer , parameter :: ngs20 = 44
      integer , parameter :: ngs21 = 54
      integer , parameter :: ngs22 = 56
      integer , parameter :: ngs23 = 66
      integer , parameter :: ngs24 = 74
      integer , parameter :: ngs25 = 80
      integer , parameter :: ngs26 = 86
      integer , parameter :: ngs27 = 94
      integer , parameter :: ngs28 = 100
      integer , parameter :: ngs29 = 112

! Use for 224 g-point model   
!      integer , parameter :: ng16 = 16
!      integer , parameter :: ng17 = 16
!      integer , parameter :: ng18 = 16
!      integer , parameter :: ng19 = 16
!      integer , parameter :: ng20 = 16
!      integer , parameter :: ng21 = 16
!      integer , parameter :: ng22 = 16
!      integer , parameter :: ng23 = 16
!      integer , parameter :: ng24 = 16
!      integer , parameter :: ng25 = 16
!      integer , parameter :: ng26 = 16
!      integer , parameter :: ng27 = 16
!      integer , parameter :: ng28 = 16
!      integer , parameter :: ng29 = 16

!      integer , parameter :: ngs16 = 16
!      integer , parameter :: ngs17 = 32
!      integer , parameter :: ngs18 = 48
!      integer , parameter :: ngs19 = 64
!      integer , parameter :: ngs20 = 80
!      integer , parameter :: ngs21 = 96
!      integer , parameter :: ngs22 = 112
!      integer , parameter :: ngs23 = 128
!      integer , parameter :: ngs24 = 144
!      integer , parameter :: ngs25 = 160
!      integer , parameter :: ngs26 = 176
!      integer , parameter :: ngs27 = 192
!      integer , parameter :: ngs28 = 208
!      integer , parameter :: ngs29 = 224

! Source function solar constant
      real , parameter :: rrsw_scon = 1.36822e+03     ! W/m2
 
      end module parrrsw_f

      module rrsw_aer_f

      use parrrsw_f, only : nbndsw, naerec

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw aerosol optical properties
!
!  Data derived from six ECMWF aerosol types and defined for
!  the rrtmg_sw spectral intervals
!
! Initial: J.-J. Morcrette, ECMWF, mar2003
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------
!
!-- The six ECMWF aerosol types are respectively:
!
!  1/ continental average                 2/ maritime
!  3/ desert                              4/ urban
!  5/ volcanic active                     6/ stratospheric background
!
! computed from Hess and Koepke (con, mar, des, urb)
!          from Bonnel et al.   (vol, str)
!
! rrtmg_sw 14 spectral intervals (microns):
!  3.846 -  3.077
!  3.077 -  2.500
!  2.500 -  2.150
!  2.150 -  1.942
!  1.942 -  1.626
!  1.626 -  1.299
!  1.299 -  1.242
!  1.242 -  0.7782
!  0.7782-  0.6250
!  0.6250-  0.4415
!  0.4415-  0.3448
!  0.3448-  0.2632
!  0.2632-  0.2000
! 12.195 -  3.846
!
!------------------------------------------------------------------
!
!  name     type     purpose
! -----   : ----   : ----------------------------------------------
! rsrtaua : real   : ratio of average optical thickness in 
!                    spectral band to that at 0.55 micron
! rsrpiza : real   : average single scattering albedo (unitless)
! rsrasya : real   : average asymmetry parameter (unitless)
!------------------------------------------------------------------

      real  :: rsrtaua(nbndsw,naerec)
      real  :: rsrpiza(nbndsw,naerec)
      real  :: rsrasya(nbndsw,naerec)

      end module rrsw_aer_f

      module rrsw_cld_f

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw cloud property coefficients
!
! Initial: J.-J. Morcrette, ECMWF, oct1999
! Revised: J. Delamere/MJIacono, AER, aug2005
! Revised: MJIacono, AER, nov2005
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------
!
!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! xxxliq1 : real   : optical properties (extinction coefficient, single 
!                    scattering albedo, assymetry factor) from
!                    Hu & Stamnes, j. clim., 6, 728-742, 1993.  
! xxxice2 : real   : optical properties (extinction coefficient, single 
!                    scattering albedo, assymetry factor) from streamer v3.0,
!                    Key, streamer user's guide, cooperative institude 
!                    for meteorological studies, 95 pp., 2001.
! xxxice3 : real   : optical properties (extinction coefficient, single 
!                    scattering albedo, assymetry factor) from
!                    Fu, j. clim., 9, 1996.
! xbari   : real   : optical property coefficients for five spectral 
!                    intervals (2857-4000, 4000-5263, 5263-7692, 7692-14285,
!                    and 14285-40000 wavenumbers) following 
!                    Ebert and Curry, jgr, 97, 3831-3836, 1992.
!------------------------------------------------------------------

      real  :: extliq1(58,16:29), ssaliq1(58,16:29), asyliq1(58,16:29)
      real  :: extice2(43,16:29), ssaice2(43,16:29), asyice2(43,16:29)
      real  :: extice3(46,16:29), ssaice3(46,16:29), asyice3(46,16:29)
      real  :: fdlice3(46,16:29)
      real  :: abari(5),bbari(5),cbari(5),dbari(5),ebari(5),fbari(5)

      end module rrsw_cld_f

      module rrsw_con_f

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw 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 rrsw_con_f

      module rrsw_kg16_f

      use parrrsw_f, only : ng16

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 16
! band 16:  2600-3250 cm-1 (low - h2o,ch4; high - ch4)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no16 = 16

      real  :: kao(9,5,13,no16)
      real  :: kbo(5,13:59,no16)
      real  :: selfrefo(10,no16), forrefo(3,no16)
      real  :: sfluxrefo(no16)

      integer :: layreffr
      real  :: rayl, strrat1

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 16
! band 16:  2600-3250 cm-1 (low - h2o,ch4; high - ch4)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng16) , absa(585,ng16)
      real  :: kb(5,13:59,ng16), absb(235,ng16)
      real  :: selfref(10,ng16), forref(3,ng16)
      real  :: sfluxref(ng16)

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

      end module rrsw_kg16_f

      module rrsw_kg17_f

      use parrrsw_f, only : ng17

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 17
! band 17:  3250-4000 cm-1 (low - h2o,co2; high - h2o,co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no17 = 16

      real  :: kao(9,5,13,no17)
      real  :: kbo(5,5,13:59,no17)
      real  :: selfrefo(10,no17), forrefo(4,no17)
      real  :: sfluxrefo(no17,5)

      integer :: layreffr
      real  :: rayl, strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 17
! band 17:  3250-4000 cm-1 (low - h2o,co2; high - h2o,co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng17) , absa(585,ng17)
      real  :: kb(5,5,13:59,ng17), absb(1175,ng17)
      real  :: selfref(10,ng17), forref(4,ng17)
      real  :: sfluxref(ng17,5)

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

      end module rrsw_kg17_f

      module rrsw_kg18_f

      use parrrsw_f, only : ng18

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 18
! band 18:  4000-4650 cm-1 (low - h2o,ch4; high - ch4)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no18 = 16

      real  :: kao(9,5,13,no18)
      real  :: kbo(5,13:59,no18)
      real  :: selfrefo(10,no18), forrefo(3,no18)
      real  :: sfluxrefo(no18,9)

      integer :: layreffr
      real  :: rayl, strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 18
! band 18:  4000-4650 cm-1 (low - h2o,ch4; high - ch4)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng18), absa(585,ng18)
      real  :: kb(5,13:59,ng18), absb(235,ng18)
      real  :: selfref(10,ng18), forref(3,ng18)
      real  :: sfluxref(ng18,9)

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

      end module rrsw_kg18_f

      module rrsw_kg19_f

      use parrrsw_f, only : ng19

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 19
! band 19:  4650-5150 cm-1 (low - h2o,co2; high - co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no19 = 16

      real  :: kao(9,5,13,no19)
      real  :: kbo(5,13:59,no19)
      real  :: selfrefo(10,no19), forrefo(3,no19)
      real  :: sfluxrefo(no19,9)

      integer :: layreffr
      real  :: rayl, strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 19
! band 19:  4650-5150 cm-1 (low - h2o,co2; high - co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng19), absa(585,ng19)
      real  :: kb(5,13:59,ng19), absb(235,ng19)
      real  :: selfref(10,ng19), forref(3,ng19)
      real  :: sfluxref(ng19,9)

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

      end module rrsw_kg19_f

      module rrsw_kg20_f

      use parrrsw_f, only : ng20

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 20
! band 20:  5150-6150 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
! absch4o : real     
!-----------------------------------------------------------------

      integer , parameter :: no20 = 16

      real  :: kao(5,13,no20)
      real  :: kbo(5,13:59,no20)
      real  :: selfrefo(10,no20), forrefo(4,no20)
      real  :: sfluxrefo(no20)
      real  :: absch4o(no20)

      integer :: layreffr
      real  :: rayl 

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 20
! band 20:  5150-6150 cm-1 (low - h2o; high - h2o)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
! absch4  : real     
!-----------------------------------------------------------------

      real  :: ka(5,13,ng20), absa(65,ng20)
      real  :: kb(5,13:59,ng20), absb(235,ng20)
      real  :: selfref(10,ng20), forref(4,ng20)
      real  :: sfluxref(ng20)
      real  :: absch4(ng20)

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

      end module rrsw_kg20_f

      module rrsw_kg21_f

      use parrrsw_f, only : ng21

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 21
! band 21:  6150-7700 cm-1 (low - h2o,co2; high - h2o,co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no21 = 16

      real  :: kao(9,5,13,no21)
      real  :: kbo(5,5,13:59,no21)
      real  :: selfrefo(10,no21), forrefo(4,no21)
      real  :: sfluxrefo(no21,9)

      integer :: layreffr
      real  :: rayl, strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 21
! band 21:  6150-7700 cm-1 (low - h2o,co2; high - h2o,co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng21), absa(585,ng21)
      real  :: kb(5,5,13:59,ng21), absb(1175,ng21)
      real  :: selfref(10,ng21), forref(4,ng21)
      real  :: sfluxref(ng21,9)

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

      end module rrsw_kg21_f

      module rrsw_kg22_f

      use parrrsw_f, only : ng22

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 22
! band 22:  7700-8050 cm-1 (low - h2o,o2; high - o2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no22 = 16

      real  :: kao(9,5,13,no22)
      real  :: kbo(5,13:59,no22)
      real  :: selfrefo(10,no22), forrefo(3,no22)
      real  :: sfluxrefo(no22,9)

      integer :: layreffr
      real  :: rayl, strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 22
! band 22:  7700-8050 cm-1 (low - h2o,o2; high - o2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng22), absa(585,ng22)
      real  :: kb(5,13:59,ng22), absb(235,ng22)
      real  :: selfref(10,ng22), forref(3,ng22)
      real  :: sfluxref(ng22,9)

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

      end module rrsw_kg22_f

      module rrsw_kg23_f

      use parrrsw_f, only : ng23

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 23
! band 23:  8050-12850 cm-1 (low - h2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no23 = 16

      real  :: kao(5,13,no23)
      real  :: selfrefo(10,no23), forrefo(3,no23)
      real  :: sfluxrefo(no23)
      real  :: raylo(no23)

      integer :: layreffr
      real :: givfac

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 23
! band 23:  8050-12850 cm-1 (low - h2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(5,13,ng23), absa(65,ng23)
      real  :: selfref(10,ng23), forref(3,ng23)
      real  :: sfluxref(ng23), rayl(ng23)

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

      end module rrsw_kg23_f

      module rrsw_kg24_f

      use parrrsw_f, only : ng24

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 24
! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real
!sfluxrefo: real     
! abso3ao : real     
! abso3bo : real     
! raylao  : real     
! raylbo  : real     
!-----------------------------------------------------------------

      integer , parameter :: no24 = 16

      real  :: kao(9,5,13,no24)
      real  :: kbo(5,13:59,no24)
      real  :: selfrefo(10,no24), forrefo(3,no24)
      real  :: sfluxrefo(no24,9)
      real  :: abso3ao(no24), abso3bo(no24)
      real  :: raylao(no24,9), raylbo(no24)

      integer :: layreffr
      real :: strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 24
! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! selfref : real     
! forref  : real
! sfluxref: real     
! abso3a  : real     
! abso3b  : real     
! rayla   : real     
! raylb   : real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng24), absa(585,ng24)
      real  :: kb(5,13:59,ng24), absb(235,ng24)
      real  :: selfref(10,ng24), forref(3,ng24)
      real  :: sfluxref(ng24,9)
      real  :: abso3a(ng24), abso3b(ng24)
      real  :: rayla(ng24,9), raylb(ng24)

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

      end module rrsw_kg24_f

      module rrsw_kg25_f

      use parrrsw_f, only : ng25

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 25
! band 25: 16000-22650 cm-1 (low - h2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
!sfluxrefo: real     
! abso3ao : real     
! abso3bo : real     
! raylo   : real     
!-----------------------------------------------------------------

      integer , parameter :: no25 = 16

      real  :: kao(5,13,no25)
      real  :: sfluxrefo(no25)
      real  :: abso3ao(no25), abso3bo(no25)
      real  :: raylo(no25)

      integer :: layreffr

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 25
! band 25: 16000-22650 cm-1 (low - h2o; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! absa    : real
! sfluxref: real     
! abso3a  : real     
! abso3b  : real     
! rayl    : real     
!-----------------------------------------------------------------

      real  :: ka(5,13,ng25), absa(65,ng25)
      real  :: sfluxref(ng25)
      real  :: abso3a(ng25), abso3b(ng25)
      real  :: rayl(ng25)

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

      end module rrsw_kg25_f

      module rrsw_kg26_f

      use parrrsw_f, only : ng26

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 26
! band 26: 22650-29000 cm-1 (low - nothing; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
!sfluxrefo: real     
! raylo   : real     
!-----------------------------------------------------------------

      integer , parameter :: no26 = 16

      real  :: sfluxrefo(no26)
      real  :: raylo(no26)

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 26
! band 26: 22650-29000 cm-1 (low - nothing; high - nothing)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! sfluxref: real     
! rayl    : real     
!-----------------------------------------------------------------

      real  :: sfluxref(ng26)
      real  :: rayl(ng26)

      end module rrsw_kg26_f

      module rrsw_kg27_f

      use parrrsw_f, only : ng27

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 27
! band 27: 29000-38000 cm-1 (low - o3; high - o3)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
!sfluxrefo: real     
! raylo   : real     
!-----------------------------------------------------------------

      integer , parameter :: no27 = 16

      real  :: kao(5,13,no27)
      real  :: kbo(5,13:59,no27)
      real  :: sfluxrefo(no27)
      real  :: raylo(no27)

      integer :: layreffr
      real :: scalekur

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 27
! band 27: 29000-38000 cm-1 (low - o3; high - o3)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! absa    : real
! absb    : real
! sfluxref: real     
! rayl    : real     
!-----------------------------------------------------------------

      real  :: ka(5,13,ng27), absa(65,ng27)
      real  :: kb(5,13:59,ng27), absb(235,ng27)
      real  :: sfluxref(ng27)
      real  :: rayl(ng27)

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

      end module rrsw_kg27_f

      module rrsw_kg28_f

      use parrrsw_f, only : ng28

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 28
! band 28: 38000-50000 cm-1 (low - o3, o2; high - o3, o2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
!sfluxrefo: real     
!-----------------------------------------------------------------

      integer , parameter :: no28 = 16

      real  :: kao(9,5,13,no28)
      real  :: kbo(5,5,13:59,no28)
      real  :: sfluxrefo(no28,5)

      integer :: layreffr
      real  :: rayl, strrat

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 28
! band 28: 38000-50000 cm-1 (low - o3, o2; high - o3, o2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! sfluxref: real     
!-----------------------------------------------------------------

      real  :: ka(9,5,13,ng28), absa(585,ng28)
      real  :: kb(5,5,13:59,ng28), absb(1175,ng28)
      real  :: sfluxref(ng28,5)

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

      end module rrsw_kg28_f

      module rrsw_kg29_f

      use parrrsw_f, only : ng29

!     implicit none
      save

!-----------------------------------------------------------------
! rrtmg_sw ORIGINAL abs. coefficients for interval 29
! band 29:  820-2600 cm-1 (low - h2o; high - co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! kao     : real     
! kbo     : real     
! selfrefo: real     
! forrefo : real     
!sfluxrefo: real     
! absh2oo : real     
! absco2o : real     
!-----------------------------------------------------------------

      integer , parameter :: no29 = 16

      real  :: kao(5,13,no29)
      real  :: kbo(5,13:59,no29)
      real  :: selfrefo(10,no29), forrefo(4,no29)
      real  :: sfluxrefo(no29)
      real  :: absh2oo(no29), absco2o(no29)

      integer :: layreffr
      real  :: rayl

!-----------------------------------------------------------------
! rrtmg_sw COMBINED abs. coefficients for interval 29
! band 29:  820-2600 cm-1 (low - h2o; high - co2)
!
! Initial version:  JJMorcrette, ECMWF, oct1999
! Revised: MJIacono, AER, jul2006
! Revised: MJIacono, AER, aug2008
!-----------------------------------------------------------------
!
!  name     type     purpose
!  ----   : ----   : ---------------------------------------------
! ka      : real     
! kb      : real     
! selfref : real     
! forref  : real     
! sfluxref: real     
! absh2o  : real     
! absco2  : real     
!-----------------------------------------------------------------

      real  :: ka(5,13,ng29), absa(65,ng29)
      real  :: kb(5,13:59,ng29), absb(235,ng29)
      real  :: selfref(10,ng29), forref(4,ng29)
      real  :: sfluxref(ng29)
      real  :: absh2o(ng29), absco2(ng29)

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

      end module rrsw_kg29_f

      module rrsw_ref_f

!      implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw 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
!------------------------------------------------------------------

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

      end module rrsw_ref_f

      module rrsw_tbl_f

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw lookup table arrays

! Initial version: MJIacono, AER, may2007
! Revised: MJIacono, AER, aug2007
! Revised: MJIacono, AER, aug2008
!------------------------------------------------------------------

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! ntbl   :  integer: Lookup table dimension
! tblint :  real   : Lookup table conversion factor
! tau_tbl:  real   : Clear-sky optical depth 
! exp_tbl:  real   : Exponential lookup table for transmittance
! od_lo  :  real   : Value of tau below which expansion is used
!                  : in place of lookup table
! pade   :  real   : Pade approximation constant
! bpade  :  real   : Inverse of Pade constant
!------------------------------------------------------------------

      integer , parameter :: ntbl = 10000

      real , parameter :: tblint = 10000.0 

      real , parameter :: od_lo = 0.06 

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

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

      end module rrsw_tbl_f

      module rrsw_vsn_f

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw version information

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

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
!hnamrtm :character: 
!hnamini :character: 
!hnamcld :character: 
!hnamclc :character: 
!hnamrft :character: 
!hnamspv :character: 
!hnamspc :character: 
!hnamset :character: 
!hnamtau :character: 
!hnamvqd :character: 
!hnamatm :character: 
!hnamutl :character: 
!hnamext :character: 
!hnamkg  :character: 
!
! hvrrtm :character: 
! hvrini :character: 
! hvrcld :character: 
! hvrclc :character: 
! hvrrft :character: 
! hvrspv :character: 
! hvrspc :character: 
! hvrset :character: 
! hvrtau :character: 
! hvrvqd :character: 
! hvratm :character: 
! hvrutl :character: 
! hvrext :character: 
! hvrkg  :character: 
!------------------------------------------------------------------

      character*18 hvrrtm,hvrini,hvrcld,hvrclc,hvrrft,hvrspv, &
                   hvrspc,hvrset,hvrtau,hvrvqd,hvratm,hvrutl,hvrext
      character*20 hnamrtm,hnamini,hnamcld,hnamclc,hnamrft,hnamspv, &
                   hnamspc,hnamset,hnamtau,hnamvqd,hnamatm,hnamutl,hnamext

      character*18 hvrkg
      character*20 hnamkg

      end module rrsw_vsn_f

      module rrsw_wvn_f

      use parrrsw_f, only : nbndsw, mg, ngptsw, jpb1, jpb2

!     implicit none
      save

!------------------------------------------------------------------
! rrtmg_sw spectral information

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

!  name     type     purpose
! -----  :  ----   : ----------------------------------------------
! ng     :  integer: Number of original g-intervals in each spectral band
! nspa   :  integer: 
! nspb   :  integer: 
!wavenum1:  real   : Spectral band lower boundary in wavenumbers
!wavenum2:  real   : Spectral band upper boundary in wavenumbers
! delwave:  real   : Spectral band width in wavenumbers
!
! 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 
!                    (224 total) into reduced set of g-intervals 
!                    (112 total)
!------------------------------------------------------------------

      integer  :: ng(jpb1:jpb2)
      integer  :: nspa(jpb1:jpb2)
      integer  :: nspb(jpb1:jpb2)

      real  :: wavenum1(jpb1:jpb2)
      real  :: wavenum2(jpb1:jpb2)
      real  :: delwave(jpb1:jpb2)
      integer :: icxa(jpb1:jpb2)

      integer  :: ngc(nbndsw)
      integer  :: ngs(nbndsw)
      integer  :: ngn(ngptsw)
      integer  :: ngb(ngptsw)
      integer  :: ngm(nbndsw*mg)

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

      end module rrsw_wvn_f


      module mcica_subcol_gen_sw_f

      use parrrsw_f, only : nbndsw, ngptsw
      use rrsw_con_f, only: grav
      use rrsw_wvn_f, only: ngb
      use rrsw_vsn_f

      implicit none

      public :: mcica_sw      
      
      contains
!-------------------------------------------------------------------------------------------------
      subroutine mcica_sw(ncol, nlay, nsubcol, icld, irng, play, cld, ciwp, clwp, cswp, &
                          tauc, ssac, asmc, fsfc, cld_stoch, ciwp_stoch, clwp_stoch, cswp_stoch, &
                          tauc_stoch, ssac_stoch, asmc_stoch, fsfc_stoch, changeSeed )
!-------------------------------------------------------------------------------------------------

  !----------------------------------------------------------------------------------------------------------------
  ! ---------------------
  ! 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).
  !---------------------------------------------------------------------------------------------------------------

      use mcica_random_numbers_f
! The Mersenne Twister random number engine
      !use MersenneTwister, only: randomNumberSequence, &   
      !                           new_RandomNumberSequence, getRandomReal

      !type(randomNumberSequence) :: randomNumbers

! -- Arguments

      integer , intent(in) :: ncol            ! number of layers
      integer , intent(in) :: nlay            ! number of layers
      integer , intent(in) :: icld            ! clear/cloud, cloud overlap flag
      integer , intent(inout) :: irng         ! flag for random number generator
                                                      !  0 = kissvec
                                                      !  1 = Mersenne Twister
      integer , intent(in) :: nsubcol         ! number of sub-columns (g-point intervals)
      integer , optional, intent(in) :: changeSeed     ! allows permuting seed

! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state 
      real , intent(in) :: play(:,:)          ! layer pressure (Pa)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cld(:,:)           ! cloud fraction 
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: clwp(:,:)          ! in-cloud liquid water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: ciwp(:,:)          ! in-cloud ice water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: cswp(:,:)          ! in-cloud snow water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: tauc(:,:,:)        ! in-cloud optical depth (non-delta scaled)
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: ssac(:,:,:)        ! in-cloud single scattering albedo (non-delta scaled)
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: asmc(:,:,:)        ! in-cloud asymmetry parameter (non-delta scaled)
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: fsfc(:,:,:)        ! in-cloud forward scattering fraction (non-delta scaled)
                                                      !    Dimensions: (ncol,nlay,nbndsw)

      real , intent(out) :: cld_stoch(:,:,:)  ! subcolumn cloud fraction 
                                                      !    Dimensions: (ngptsw,ncol,nlay)
      real , intent(out) :: clwp_stoch(:,:,:) ! subcolumn in-cloud liquid water path
                                                      !    Dimensions: (ngptsw,ncol,nlay)
      real , intent(out) :: ciwp_stoch(:,:,:) ! subcolumn in-cloud ice water path
                                                      !    Dimensions: (ngptsw,ncol,nlay)
      real , intent(out) :: cswp_stoch(:,:,:) ! subcolumn in-cloud snow water path
                                                      !    Dimensions: (ngptsw,ncol,nlay)
      real , intent(out) :: tauc_stoch(:,:,:) ! subcolumn in-cloud optical depth
                                                      !    Dimensions: (ncol,nlay,ngptsw)
      real , intent(out) :: ssac_stoch(:,:,:) ! subcolumn in-cloud single scattering albedo
                                                      !    Dimensions: (ncol,nlay,ngptsw)
      real , intent(out) :: asmc_stoch(:,:,:) ! subcolumn in-cloud asymmetry parameter
                                                      !    Dimensions: (ncol,nlay,ngptsw)
      real , intent(out) :: fsfc_stoch(:,:,:) ! subcolumn in-cloud forward scattering fraction
                                                      !    Dimensions: (ncol,nlay,ngptsw)
      
! -- Local variables

! Constants (min value for cloud fraction and cloud water and ice)
      real , parameter :: cldmin = 1.0e-20  ! min cloud fraction

#ifndef _ACCEL
# define ncol CHNK
#endif

! Variables related to random number and seed 
     
      real, dimension(ncol, nlay, nsubcol) gpu_device :: CDF       
#ifdef _ACCEL
      integer :: seed1, seed2, seed3, seed4  ! seed to create random number
#else
      integer, dimension(ncol) :: seed1, seed2, seed3, seed4  ! seed to create random number
#endif
    
      integer  :: iseed                        ! seed to create random number (Mersenne Twister)
!      real  :: rand_num_mt                     ! random number (Mersenne Twister)
      real  :: kiss


! Indices
      integer  :: ilev, isubcol, i, n, ngbm, iplon   ! indices
#ifndef _ACCEL
      integer :: m, k
! inline function
      m(k, n) = ieor (k, ishft (k, n) )
#endif
!------------------------------------------------------------------------------------------ 

! Check that irng is in bounds; if not, set to default
! Note: in GPU version of code, only kissvec method is used, Mersenne Twister not installed

! Pass input cloud overlap setting to local variable


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

! generate the random numbers  

! Random cloud overlap
      if (icld==1) then
!$acc kernels 
           
#ifdef _ACCEL
            do ilev = 1,nlay
               do i = 1, ncol
                  seed1 = (play(i,1) - int(play(i,1)))  * 100000000 - ilev
                  seed2 = (play(i,2) - int(play(i,2)))  * 100000000 + ilev
                  seed3 = (play(i,3) - int(play(i,3)))  * 100000000 + ilev * 6.2
                  seed4 = (play(i,4) - int(play(i,4)))  * 100000000           
                  do isubcol = 1,nsubcol
                     seed1 = 69069  * seed1 + 132721785 
                     seed2 = 11002  * iand (seed2, 65535 ) + ishft (seed2, - 16 )
                     seed3 = 18000  * iand (seed3, 65535 ) + ishft (seed3, - 16 )
                     seed4 = 30903  * iand (seed4, 65535 ) + ishft (seed4, - 16 )
                     kiss = seed1 + seed2 + ishft (seed3, 16 ) + seed4
                     CDF(i,ilev,isubcol) = kiss*2.328306e-10  + 0.5 
                  end do
               end do
            end do
#else
         CALL wrf_error_fatal("icld == 1 not supported in module_ra_rrtmg_swf.F")
#endif

!$acc end kernels      
      endif

! Maximum-Random cloud overlap
      if (icld==2) then
#ifdef _ACCEL
!$acc kernels 
           
            do ilev = 1,nlay
               do i = 1, ncol
                  seed1 = (play(i,1) - int(play(i,1)))  * 100000000 - ilev
                  seed2 = (play(i,2) - int(play(i,2)))  * 100000000 + ilev
                  seed3 = (play(i,3) - int(play(i,3)))  * 100000000 + ilev * 6.2
                  seed4 = (play(i,4) - int(play(i,4)))  * 100000000           
                  do isubcol = 1,nsubcol
                     seed1 = 69069  * seed1 + 132721785 
                     seed2 = 11002  * iand (seed2, 65535 ) + ishft (seed2, - 16 )
                     seed3 = 18000  * iand (seed3, 65535 ) + ishft (seed3, - 16 )
                     seed4 = 30903  * iand (seed4, 65535 ) + ishft (seed4, - 16 )
                     kiss = seed1 + seed2 + ishft (seed3, 16 ) + seed4
                     CDF(i,ilev,isubcol) = kiss*2.328306e-10  + 0.5 
                  end do
               end do
            end do

            do ilev = 2,nlay
               do i = 1, ncol
                  do isubcol = 1,nsubcol
                     if (CDF(i,ilev-1,isubcol) > 1.  - cld(i, ilev-1)) then 
                        CDF(i,ilev,isubcol) = CDF(i,ilev-1,isubcol)
                     else
                        CDF(i,ilev,isubcol) = CDF(i,ilev,isubcol) * (1. - cld(i, ilev-1))
                     end if
                  end do
               end do
            end do
            
!$acc end kernels      
#else
!jm set up to match the ra_sw_physics=4 random number generator '

!jm moved isubcol loop out of here and put in the ilev.eq.1 conditional for initial
!jm computation of seeds so we get the same results as the ra_sw_physics=4 option
           do isubcol = 1,nsubcol
           do ilev = 1,nlay
               do i = 1, ncol
                if (ilev.eq.1.and.isubcol.eq.1)then
                  seed1(i) = (play(i,1)*100 - int(play(i,1)*100))  * 1000000000  !jm
                  seed2(i) = (play(i,2)*100 - int(play(i,2)*100))  * 1000000000  !jm
                  seed3(i) = (play(i,3)*100 - int(play(i,3)*100))  * 1000000000  !jm
                  seed4(i) = (play(i,4)*100 - int(play(i,4)*100))  * 1000000000
                     seed1(i) = 69069  * seed1(i) + 1327217885
                     seed2(i) = m (m (m (seed2(i), 13), - 17), 5)
                     seed3(i) = 18000  * iand (seed3(i), 65535 ) + ishft (seed3(i), - 16 )
                     seed4(i) = 30903  * iand (seed4(i), 65535 ) + ishft (seed4(i), - 16 )
                     kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16 ) + seed4(i)
                 endif

                 seed1(i) = 69069  * seed1(i) + 1327217885
                 seed2(i) = m (m (m (seed2(i), 13), - 17), 5)
                 seed3(i) = 18000  * iand (seed3(i), 65535 ) + ishft (seed3(i), - 16 )
                 seed4(i) = 30903  * iand (seed4(i), 65535 ) + ishft (seed4(i), - 16 )
                 kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16 ) + seed4(i)

                 CDF(i,ilev,isubcol) = kiss*2.328306e-10  + 0.5
               end do
            end do
            end do

            do ilev = 2,nlay
               do i = 1, ncol
                  do isubcol = 1,nsubcol
                     if (CDF(i,ilev-1,isubcol) > 1.  - cld(i, ilev-1)) then
                        CDF(i,ilev,isubcol) = CDF(i,ilev-1,isubcol)
                     else
                        CDF(i,ilev,isubcol) = CDF(i,ilev,isubcol) * (1. - cld(i, ilev-1))
                     end if
                  end do
               end do
            end do
#endif
      endif

! Maximum cloud overlap
      if (icld==3) then
!$acc kernels 
           
#ifdef _ACCEL
            do i = 1, ncol
               seed1 = (play(i,1) - int(play(i,1)))  * 100000000 - ilev
               seed2 = (play(i,2) - int(play(i,2)))  * 100000000 + ilev
               seed3 = (play(i,3) - int(play(i,3)))  * 100000000 + ilev * 6.2
               seed4 = (play(i,4) - int(play(i,4)))  * 100000000           
               do isubcol = 1,nsubcol
                  seed1 = 69069  * seed1 + 132721785 
                  seed2 = 11002  * iand (seed2, 65535 ) + ishft (seed2, - 16 )
                  seed3 = 18000  * iand (seed3, 65535 ) + ishft (seed3, - 16 )
                  seed4 = 30903  * iand (seed4, 65535 ) + ishft (seed4, - 16 )
                  kiss = seed1 + seed2 + ishft (seed3, 16 ) + seed4
                  do ilev = 1,nlay
                     CDF(i,ilev,isubcol) = kiss*2.328306e-10  + 0.5 
                  end do
               end do
            end do
#else
         CALL wrf_error_fatal("icld == 3 not supported in module_ra_rrtmg_swf.F")
#endif

!$acc end kernels      
      endif

      ngbm = ngb(1) - 1
!$acc kernels 
      do ilev = 1,nlay
         do i = 1, ncol
            do isubcol = 1, nsubcol

               if ( CDF(i,ilev,isubcol)>=(1.0 - cld(i,ilev)) ) then
                  cld_stoch(i,ilev,isubcol) = 1.0 
                  clwp_stoch(i,ilev,isubcol) = clwp(i,ilev)
                  ciwp_stoch(i,ilev,isubcol) = ciwp(i,ilev)
                  cswp_stoch(i,ilev,isubcol) = cswp(i,ilev)
                  n = ngb(isubcol) - ngbm
                  tauc_stoch(i,ilev,isubcol) = tauc(i,ilev,n)
                  ssac_stoch(i,ilev,isubcol) = ssac(i,ilev,n)
                  asmc_stoch(i,ilev,isubcol) = asmc(i,ilev,n)
                  fsfc_stoch(i,ilev,isubcol) = fsfc(i,ilev,n)
               else
                  cld_stoch(i,ilev,isubcol) = 0. 
                  clwp_stoch(i,ilev,isubcol) = 0. 
                  ciwp_stoch(i,ilev,isubcol) = 0. 
                  cswp_stoch(i,ilev,isubcol) = 0. 
                  tauc_stoch(i,ilev,isubcol) = 0. 
                  ssac_stoch(i,ilev,isubcol) = 1. 
                  asmc_stoch(i,ilev,isubcol) = 0. 
                  fsfc_stoch(i,ilev,isubcol) = 0. 
               endif
            enddo
         enddo
      enddo
!$acc end kernels
#ifndef _ACCEL
# undef ncol
#endif

      end subroutine mcica_sw

      end module mcica_subcol_gen_sw_f

      module rrtmg_sw_cldprmc_f

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

      use parrrsw_f, only : ngptsw, jpband, jpb1, jpb2
      use rrsw_cld_f, only : extliq1, ssaliq1, asyliq1, &
                           extice2, ssaice2, asyice2, &
                           extice3, ssaice3, asyice3, fdlice3, &
                           abari, bbari, cbari, dbari, ebari, fbari
      use rrsw_wvn_f, only : wavenum2, ngb, icxa
      use rrsw_vsn_f, only : hvrclc, hnamclc

      implicit none

      contains

! ----------------------------------------------------------------------------
      subroutine cldprmc_sw(ncol, nlayers, inflag, iceflag, liqflag, cldfmc, &
                            ciwpmc, clwpmc, cswpmc, reicmc, relqmc, resnmc, &
                            taormc, taucmc, ssacmc, asmcmc, fsfcmc)
! ----------------------------------------------------------------------------

! Purpose: Compute the cloud optical properties for each cloudy layer
! and g-point interval for use by the McICA method.  
! Note: Only inflag = 0 and inflag=2/liqflag=1/iceflag=1,2,3 are available;
! (Hu & Stamnes, Ebert and Curry, Key, and Fu) are implemented. 

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

      integer , intent(in) :: nlayers         ! total number of layers
      integer , intent(in) :: inflag          ! see definitions
      integer , intent(in) :: iceflag         ! see definitions
      integer , intent(in) :: liqflag         ! see definitions
      integer , intent(in) :: ncol

      real , intent(in) :: cldfmc(:,:,:)          ! cloud fraction [mcica]
                                                      !    Dimensions: (ngptsw,nlayers)
      real , intent(in) :: ciwpmc(:,:,:)          ! cloud ice water path [mcica]
                                                      !    Dimensions: (ngptsw,nlayers)
      real , intent(in) :: clwpmc(:,:,:)          ! cloud liquid water path [mcica]
                                                      !    Dimensions: (ngptsw,nlayers)
      real , intent(in) :: cswpmc(:,:,:)          ! cloud snow water path [mcica]
                                                      !    Dimensions: (ngptsw,nlayers)
      real , intent(in) :: relqmc(:,:)           ! cloud liquid particle effective radius (microns)
                                                      !    Dimensions: (nlayers)
      real , intent(in) :: resnmc(:,:)           ! cloud snow particle effective radius (microns)
                                                      !    Dimensions: (nlayers)
      real , intent(in) :: reicmc(:,:)           ! cloud ice particle effective radius (microns)
                                                      !    Dimensions: (nlayers)
                                                      ! specific definition of reicmc depends on setting of iceflag:
                                                      ! iceflag = 0: (inactive)
                                                      !              
                                                      ! 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 , intent(in) :: fsfcmc(:,:,:)          ! cloud forward scattering fraction
                                                      !    Dimensions: (ngptsw,nlayers)

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

      real , intent(inout) :: taucmc(:,:,:)       ! cloud optical depth (delta scaled)
                                                      !    Dimensions: (ncol,nlayers,ngptsw)
      real , intent(inout) :: ssacmc(:,:,:)       ! single scattering albedo (delta scaled)
                                                      !    Dimensions: (ncol,nlayers,ngptsw)
      real , intent(inout) :: asmcmc(:,:,:)       ! asymmetry parameter (delta scaled)
                                                      !    Dimensions: (ncol,nlayers,ngptsw)
      real , intent(out) :: taormc(:,:,:)         ! cloud optical depth (non-delta scaled)
                                                      !    Dimensions: (ncol,nlayers,ngptsw)

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

!      integer  :: ncbands
      integer  :: ib, lay, istr, index, icx, ig, iplon

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

      real  :: taucldorig_a, taucloud_a, ssacloud_a, ffp, ffp1, ffpssa
      real  :: tauiceorig, scatice, ssaice, tauice, tauliqorig, scatliq, ssaliq, tauliq
      real  :: tausnoorig, scatsno, ssasno, tausno

      real  :: fdelta
      real  :: extcoice, gice
      real  :: ssacoice, forwice
      real  :: extcoliq, gliq
      real  :: ssacoliq, forwliq
      real  :: extcosno, gsno
      real  :: ssacosno, forwsno

! Initialize


!$acc kernels

      taormc   = taucmc
  
!$acc end kernels    

#ifndef _ACCEL
#  define ncol CHNK
#endif

! Main layer loop

!$acc kernels loop present(cldfmc, ciwpmc, clwpmc, cswpmc, relqmc, reicmc, resnmc, fsfcmc,taucmc, ssacmc, asmcmc, taormc)
    do iplon = 1, ncol
      !$acc loop 
      do lay = 1, nlayers

         !$acc loop private(fdelta,extcoice,gice,ssacoice,forwice,extcoliq,gliq,ssacoliq,forwliq,gsno,forwsno,scatsno)
         do ig = 1, ngptsw 
            cwp = ciwpmc(iplon,lay,ig) + clwpmc(iplon,lay,ig) + cswpmc(iplon,lay,ig)  

            if (cldfmc(iplon,lay,ig)   .ge. cldmin .and. &
               (cwp .ge. cldmin .or. taucmc(iplon,lay,ig)   .ge. cldmin)) then

! (inflag=0): Cloud optical properties input directly
               if (inflag .eq. 0) then
! Cloud optical properties already defined in taucmc, ssacmc, asmcmc are unscaled;
! Apply delta-M scaling here (using Henyey-Greenstein approximation)
                  taucldorig_a = taucmc(iplon,lay,ig)  
                  ffp = fsfcmc(iplon,lay,ig)  
                  ffp1 = 1.0  - ffp
                  ffpssa = 1.0  - ffp * ssacmc(iplon,lay,ig)  
                  ssacloud_a = ffp1 * ssacmc(iplon,lay,ig)   / ffpssa
                  taucloud_a = ffpssa * taucldorig_a

                  taormc(iplon,lay,ig)   = taucldorig_a
                  ssacmc(iplon,lay,ig)   = ssacloud_a
                  taucmc(iplon,lay,ig)   = taucloud_a
                  asmcmc(iplon,lay,ig)   = (asmcmc(iplon,lay,ig)   - ffp) / (ffp1)

! (inflag=2): Separate treatement of ice clouds and water clouds.
               elseif (inflag .ge. 2) then       
                  radice = reicmc(iplon,lay) 

! Calculation of absorption coefficients due to ice clouds.
                  if (ciwpmc(iplon,lay,ig) + cswpmc(iplon,lay,ig) .eq. 0.0 ) then
                     extcoice = 0.0 
                     ssacoice = 0.0 
                     gice     = 0.0 
                     forwice  = 0.0 

                     extcosno = 0.0
                     ssacosno = 0.0
                     gsno     = 0.0
                     forwsno  = 0.0

! (iceflag = 1): 
! Note: This option uses Ebert and Curry approach for all particle sizes similar to
! CAM3 implementation, though this is somewhat unjustified for large ice particles
                  elseif (iceflag .eq. 1) then
                   
                     ib = ngb(ig )
                     ib = icxa(ib)
  
                     extcoice = (abari(ib) + bbari(ib)/radice)
                     ssacoice = 1.  - cbari(ib) - dbari(ib) * radice
                     gice = ebari(ib) + fbari(ib) * radice
! Check to ensure upper limit of gice is within physical limits for large particles
                     if (gice.ge.1. ) gice = 1.  - eps
                     forwice = gice*gice
! Check to ensure all calculated quantities are within physical limits.
! mji - added checks below
                     if (extcoice .lt. 0.0) extcoice = 0.0
                     if (ssacoice .gt. 1.0) ssacoice = 1.0
                     if (ssacoice .lt. 0.0) ssacoice = 0.0
                     if (gice .gt. 1.0) gice = 1.0
                     if (gice .lt. 0.0) gice = 0.0
                  

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

                  elseif (iceflag .eq. 2) then
                     
                     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)
                     extcoice = extice2(index,ib) + fint * &
                                   (extice2(index+1,ib) -  extice2(index,ib))
                     ssacoice = ssaice2(index,ib) + fint * &
                                   (ssaice2(index+1,ib) -  ssaice2(index,ib))
                     gice = asyice2(index,ib) + fint * &
                                   (asyice2(index+1,ib) -  asyice2(index,ib))
                     forwice = gice*gice
! Check to ensure all calculated quantities are within physical limits.
! mji - added checks below
                     if (extcoice .lt. 0.0) extcoice = 0.0
                     if (ssacoice .gt. 1.0) ssacoice = 1.0
                     if (ssacoice .lt. 0.0) ssacoice = 0.0
                     if (gice .gt. 1.0) gice = 1.0
                     if (gice .lt. 0.0) gice = 0.0
                 

! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns

                  elseif (iceflag .ge. 3) then
                    
                     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)
                     extcoice = extice3(index,ib) + fint * &
                                   (extice3(index+1,ib) - extice3(index,ib))
                     ssacoice = ssaice3(index,ib) + fint * &
                                   (ssaice3(index+1,ib) - ssaice3(index,ib))
                     gice = asyice3(index,ib) + fint * &
                               (asyice3(index+1,ib) - asyice3(index,ib))
                     fdelta = fdlice3(index,ib) + fint * &
                                 (fdlice3(index+1,ib) - fdlice3(index,ib))
                  
                     forwice = fdelta + 0.5  / ssacoice
! See Fu 1996 p. 2067 
                     if (forwice .gt. gice) forwice = gice
! Check to ensure all calculated quantities are within physical limits.  
! mji - added checks below
                     if (extcoice .lt. 0.0) extcoice = 0.0
                     if (ssacoice .gt. 1.0) ssacoice = 1.0
                     if (ssacoice .lt. 0.0) ssacoice = 0.0
                     if (gice .gt. 1.0) gice = 1.0
                     if (gice .lt. 0.0) gice = 0.0
                  
                  endif

!!!!!!!!!!!!!!!!!! Mukul !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!  INSERT THE EQUIVALENT SNOW VARIABLE CODE HERE
!!!! Although far from perfect, the snow will utilize the
!!!! same lookup table constants as cloud ice.  Changes
!!!! to those constants for larger particle snow would be
!!!! an improvement.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

                  if (cswpmc(iplon,lay,ig).gt.0.0 .and. iceflag .eq. 5) then
                     radsno = resnmc(iplon,lay)
                     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)
                     extcosno = extice3(index,ib) + fint * &
                                   (extice3(index+1,ib) - extice3(index,ib))
                     ssacosno = ssaice3(index,ib) + fint * &
                                   (ssaice3(index+1,ib) - ssaice3(index,ib))
                     gsno = asyice3(index,ib) + fint * &
                               (asyice3(index+1,ib) - asyice3(index,ib))
                     fdelta = fdlice3(index,ib) + fint * &
                                 (fdlice3(index+1,ib) - fdlice3(index,ib))
                     forwsno = fdelta + 0.5 / ssacosno
! See Fu 1996 p. 2067
                     if (forwsno .gt. gsno) forwsno = gsno
! Check to ensure all calculated quantities are within physical limits.  
! mji - added checks below
                     if (extcosno .lt. 0.0) extcosno = 0.0
                     if (ssacosno .gt. 1.0) ssacosno = 1.0
                     if (ssacosno .lt. 0.0) ssacosno = 0.0
                     if (gsno .gt. 1.0) gsno = 1.0
                     if (gsno .lt. 0.0) gsno = 0.0
!
                  else
                     extcosno = 0.0
                     ssacosno = 0.0
                     gsno     = 0.0
                     forwsno  = 0.0
                  endif

! Calculation of absorption coefficients due to water clouds.
                  if (clwpmc(iplon,lay,ig)   .eq. 0.0 ) then
                     extcoliq = 0.0 
                     ssacoliq = 0.0 
                     gliq = 0.0 
                     forwliq = 0.0 

                  elseif (liqflag .eq. 1) then
                     radliq = relqmc(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)
                     extcoliq = extliq1(index,ib) + fint * &
                                   (extliq1(index+1,ib) - extliq1(index,ib))
                     ssacoliq = ssaliq1(index,ib) + fint * &
                                   (ssaliq1(index+1,ib) - ssaliq1(index,ib))
                     if (fint .lt. 0.  .and. ssacoliq .gt. 1. ) &
                                    ssacoliq = ssaliq1(index,ib)
                     gliq = asyliq1(index,ib) + fint * &
                               (asyliq1(index+1,ib) - asyliq1(index,ib))
                     forwliq = gliq*gliq
! Check to ensure all calculated quantities are within physical limits.
! mji - added checks below
                     if (extcoliq .lt. 0.0) extcoliq = 0.0
                     if (ssacoliq .gt. 1.0) ssacoliq = 1.0
                     if (ssacoliq .lt. 0.0) ssacoliq = 0.0
                     if (gliq .gt. 1.0) gliq = 1.0
                     if (gliq .lt. 0.0) gliq = 0.0
!
                  endif
   
                  if (iceflag .lt. 5) then
                     tauliqorig = clwpmc(iplon,lay,ig)   * extcoliq
                     tauiceorig = ciwpmc(iplon,lay,ig)   * extcoice
                     taormc(iplon,lay,ig)   = tauliqorig + tauiceorig

                     ssaliq = ssacoliq * (1.  - forwliq) / &
                             (1.  - forwliq * ssacoliq)
                     tauliq = (1.  - forwliq * ssacoliq) * tauliqorig
                     ssaice = ssacoice * (1.  - forwice) / &
                             (1.  - forwice * ssacoice)
                     tauice = (1.  - forwice * ssacoice) * tauiceorig

                     scatliq = ssaliq * tauliq
                     scatice = ssaice * tauice
                     taucmc(iplon,lay,ig)   = tauliq + tauice
                  else
                     tauliqorig = clwpmc(iplon,lay,ig)   * extcoliq
                     tauiceorig = ciwpmc(iplon,lay,ig)   * extcoice
                     tausnoorig = cswpmc(iplon,lay,ig)   * extcosno
                     taormc(iplon,lay,ig)   = tauliqorig + tauiceorig + tausnoorig

                     ssaliq = ssacoliq * (1.  - forwliq) / &
                             (1.  - forwliq * ssacoliq)
                     tauliq = (1.  - forwliq * ssacoliq) * tauliqorig
                     ssaice = ssacoice * (1.  - forwice) / &
                             (1.  - forwice * ssacoice)
                     tauice = (1.  - forwice * ssacoice) * tauiceorig
                     ssasno = ssacosno * (1.  - forwsno) / &
                             (1.  - forwsno * ssacosno)
                     tausno = (1.  - forwsno * ssacosno) * tausnoorig

                     scatliq = ssaliq * tauliq
                     scatice = ssaice * tauice
                     scatsno = ssasno * tausno
                     taucmc(iplon,lay,ig)   = tauliq + tauice + tausno
                  endif

! Ensure non-zero taucmc and scatice
                  if(taucmc(iplon,lay,ig)  .eq.0.) taucmc(iplon,lay,ig)   = cldmin
                  if(scatice.eq.0.) scatice = cldmin
                  if(scatsno.eq.0.) scatsno = cldmin

                  if (iceflag .lt. 5) then
                     ssacmc(iplon,lay,ig)   = (scatliq + scatice) / taucmc(iplon,lay,ig)  
                  else
                     ssacmc(iplon,lay,ig)   = (scatliq + scatice + scatsno) / taucmc(iplon,lay,ig)  
                  endif

                  if (iceflag .eq. 3 .or. iceflag.eq.4) then
! In accordance with the 1996 Fu paper, equation A.3, 
! the moments for ice were calculated depending on whether using spheres
! or hexagonal ice crystals.
! Set asymetry parameter to first moment (istr=1)
                     istr = 1
                     asmcmc(iplon,lay,ig)   = (1.0 /(scatliq+scatice))* &
                        (scatliq*(gliq**istr - forwliq) / &
                        (1.0  - forwliq) + scatice * ((gice-forwice)/ &
                        (1.0  - forwice))**istr)

                  elseif (iceflag .eq. 5) then
                     istr = 1
                     asmcmc(iplon,lay,ig) = (1.0 /(scatliq+scatice+scatsno)) * &
                                    (scatliq*(gliq**istr - forwliq)/(1.0 - forwliq)  &
                                    + scatice * ((gice-forwice)/(1.0 - forwice))        &
                                    + scatsno * ((gsno-forwsno)/(1.0 - forwsno))**istr)

                  else 
! This code is the standard method for delta-m scaling. 
! Set asymetry parameter to first moment (istr=1)
                     istr = 1
                     asmcmc(iplon,lay,ig)   = (scatliq *  &
                        (gliq**istr - forwliq) / &
                        (1.0  - forwliq) + scatice * (gice**istr - forwice) / &
                        (1.0  - forwice))/(scatliq + scatice)
                  endif 

               endif

            endif

! End g-point interval loop
         enddo

! End layer loop
      enddo
! End column loop
      enddo
!$acc end kernels
#ifndef _ACCEL
#  undef ncol
#endif

      end subroutine cldprmc_sw

      end module rrtmg_sw_cldprmc_f

      module rrtmg_sw_setcoef_f

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

      use parrrsw_f, only : mxmol
      use rrsw_ref_f, only : pref, preflog, tref
      use rrsw_vsn_f, only : hvrset, hnamset

      implicit none

      contains

!----------------------------------------------------------------------------
      subroutine setcoef_sw(ncol, nlayers, pavel, tavel, pz, tz, tbound, coldry, wkl, &
                            laytrop, layswtch, laylow, jp, jt, jt1, &
                            co2mult, colch4, colco2, colh2o, colmol, coln2o, &
                            colo2, colo3, fac00, fac01, fac10, fac11, &
                            selffac, selffrac, indself, forfac, forfrac, indfor)
!----------------------------------------------------------------------------
!
! Purpose:  For a given atmosphere, calculate the indices and
! fractions related to the pressure and temperature interpolations.

! Modifications:
! Original: J. Delamere, AER, Inc. (version 2.5, 02/04/01)
! Revised: Rewritten and adapted to ECMWF F90, JJMorcrette 030224
! Revised: For uniform rrtmg formatting, MJIacono, Jul 2006

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

! ----- Input -----
      integer, intent(in) :: ncol

      integer , intent(in) :: nlayers         ! total number of layers
      
      real , intent(in) :: pavel(:,:)            ! layer pressures (mb) 
                                                      !    Dimensions: (nlayers)
      real , intent(in) :: tavel(:,:)            ! layer temperatures (K)
                                                      !    Dimensions: (nlayers)
      real , intent(in) :: pz(:,0:)              ! level (interface) pressures (hPa, mb)
                                                      !    Dimensions: (0:nlayers)
      real , intent(in) :: tz(:,0:)              ! level (interface) temperatures (K)
                                                      !    Dimensions: (0:nlayers)
      real , intent(in) :: tbound(:)             ! surface temperature (K)
      real , intent(in) :: coldry(:,:)           ! dry air column density (mol/cm2)
                                                      !    Dimensions: (nlayers)
      real , intent(in) :: wkl(:,:,:)            ! molecular amounts (mol/cm-2)
                                                      !    Dimensions: (mxmol,nlayers)

! ----- Output -----
      integer , intent(out) :: laytrop(:)        ! tropopause layer index
      integer , intent(out) :: layswtch(:)       ! 
      integer , intent(out) :: laylow(:)         ! 

      integer , intent(out) :: jp(:,:)           ! 
                                                      !    Dimensions: (nlayers)
      integer , intent(out) :: jt(:,:)           !
                                                      !    Dimensions: (nlayers)
      integer , intent(out) :: jt1(:,:)          !
                                                      !    Dimensions: (nlayers)

      real , intent(out) :: colh2o(:,:)          ! column amount (h2o)
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: colco2(:,:)          ! column amount (co2)
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: colo3(:,:)           ! column amount (o3)
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: coln2o(:,:)          ! column amount (n2o)
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: colch4(:,:)          ! column amount (ch4)
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: colo2(:,:)           ! column amount (o2)
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: colmol(:,:)          ! 
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: co2mult(:,:)         !
                                                      !    Dimensions: (nlayers)

      integer , intent(out) :: indself(:,:) 
                                                      !    Dimensions: (nlayers)
      integer , intent(out) :: indfor(:,:) 
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: selffac(:,:) 
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: selffrac(:,:) 
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: forfac(:,:) 
                                                      !    Dimensions: (nlayers)
      real , intent(out) :: forfrac(:,:) 
                                                      !    Dimensions: (nlayers)

      real , intent(out) :: fac00(:,:) , fac01(:,:) , fac10(:,:) , fac11(:,:)  

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

      integer  :: indbound
      integer  :: indlev0
      integer  :: lay
      integer  :: jp1
      integer  :: iplon

      real  :: stpfac
      real  :: tbndfrac
      real  :: t0frac
      real  :: plog
      real  :: fp
      real  :: ft
      real  :: ft1
      real  :: water
      real  :: scalefac
      real  :: factor
      real  :: co2reg
      real  :: compfp

#ifndef _ACCEL
#  define ncol CHNK
#endif


! Initializations
      stpfac = 296. /1013. 


!$acc kernels present(pavel, layswtch, laytrop, laylow)
      layswtch = 0
      laytrop = 0
      laylow = 0
      do iplon = 1, ncol
         do lay = 1, nlayers
            plog = log(pavel(iplon,lay) )
            if (plog .ge. 4.56) laytrop(iplon) = laytrop(iplon) + 1
            if (plog .ge. 6.62) laylow(iplon) = laylow(iplon) + 1
         end do
      end do
!$acc end kernels


!$acc kernels loop present(pavel, tavel, pz, tz, tbound) &
!$acc present(coldry, wkl, jp, jt, jt1, colh2o, colco2) &
!$acc present(colo3, coln2o, colch4, colo2, colmol, co2mult, indself) &
!$acc present(indfor, selffac, selffrac, forfac, forfrac, fac00, fac01, fac10, fac11)

! Begin column loop
      do iplon = 1, ncol

      indbound = tbound(iplon) - 159. 
      tbndfrac = tbound(iplon) - int(tbound(iplon))
      
      indlev0  = tz(iplon,0)  - 159. 
      t0frac   = tz(iplon,0)  - int(tz(iplon,0) )

! Begin layer loop

       do lay = 1, nlayers
! 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 = log(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.  * (preflog(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.  + (tavel(iplon,lay) -tref(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 = ((tavel(iplon,lay) -tref(jp(iplon,lay) ))/15. ) - float(jt(iplon,lay) -3)
         jt1(iplon,lay)  = int(3.  + (tavel(iplon,lay) -tref(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 = ((tavel(iplon,lay) -tref(jp1))/15. ) - float(jt1(iplon,lay) -3)

         water = wkl(iplon,1,lay) /coldry(iplon,lay) 
         scalefac = pavel(iplon,lay)  * stpfac / tavel(iplon,lay) 

! If the pressure is less than ~100mb, perform a different
! set of species interpolations.

         if (plog .le. 4.56 ) then

         forfac(iplon,lay)  = scalefac / (1.+water)
         factor = (tavel(iplon,lay) -188.0 )/36.0 
         indfor(iplon,lay)  = 3
         forfrac(iplon,lay)  = factor - 1.0 

! Calculate needed column amounts.

         colh2o(iplon,lay)  = 1.e-20  * wkl(iplon,1,lay) 
         colco2(iplon,lay)  = 1.e-20  * wkl(iplon,2,lay) 
         colo3(iplon,lay)   = 1.e-20  * wkl(iplon,3,lay) 
         coln2o(iplon,lay)  = 1.e-20  * wkl(iplon,4,lay) 
         colch4(iplon,lay)  = 1.e-20  * wkl(iplon,6,lay) 
         colo2(iplon,lay)   = 1.e-20  * wkl(iplon,7,lay) 
         colmol(iplon,lay)  = 1.e-20  * coldry(iplon,lay)  + colh2o(iplon,lay) 
         if (colco2(iplon,lay)  .eq. 0. ) colco2(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
         if (coln2o(iplon,lay)  .eq. 0. ) coln2o(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
         if (colch4(iplon,lay)  .eq. 0. ) colch4(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
         if (colo2(iplon,lay)   .eq. 0. ) colo2(iplon,lay)   = 1.e-32  * coldry(iplon,lay) 
         co2reg = 3.55e-24  * coldry(iplon,lay) 
         co2mult(iplon,lay) = (colco2(iplon,lay)  - co2reg) * &
               272.63 *exp(-1919.4 /tavel(iplon,lay) )/(8.7604e-4 *tavel(iplon,lay) )

         selffac(iplon,lay)  = 0. 
         selffrac(iplon,lay) = 0. 
         indself(iplon,lay)  = 0


         else


! Set up factors needed to separately include the water vapor
! foreign-continuum in the calculation of absorption coefficient.

         forfac(iplon,lay)  = scalefac / (1.+water)
         factor = (332.0 -tavel(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 = (tavel(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)

! Calculate needed column amounts.

         colh2o(iplon,lay)  = 1.e-20  * wkl(iplon,1,lay) 
         colco2(iplon,lay)  = 1.e-20  * wkl(iplon,2,lay) 
         colo3(iplon,lay)  = 1.e-20  * wkl(iplon,3,lay) 
!           colo3(lay) = 0. 
!           colo3(lay) = colo3(lay)/1.16 
         coln2o(iplon,lay)  = 1.e-20  * wkl(iplon,4,lay) 
         colch4(iplon,lay)  = 1.e-20  * wkl(iplon,6,lay) 
         colo2(iplon,lay)  = 1.e-20  * wkl(iplon,7,lay) 
         colmol(iplon,lay)  = 1.e-20  * coldry(iplon,lay)  + colh2o(iplon,lay) 
!           colco2(lay) = 0. 
!           colo3(lay) = 0. 
!           coln2o(lay) = 0. 
!           colch4(lay) = 0. 
!           colo2(lay) = 0. 
!           colmol(lay) = 0. 
         if (colco2(iplon,lay)  .eq. 0. ) colco2(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
         if (coln2o(iplon,lay)  .eq. 0. ) coln2o(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
         if (colch4(iplon,lay)  .eq. 0. ) colch4(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
         if (colo2(iplon,lay)  .eq. 0. ) colo2(iplon,lay)  = 1.e-32  * coldry(iplon,lay) 
! Using E = 1334.2 cm-1.
         co2reg = 3.55e-24  * coldry(iplon,lay) 
         co2mult(iplon,lay) = (colco2(iplon,lay)  - co2reg) * &
               272.63 *exp(-1919.4 /tavel(iplon,lay) )/(8.7604e-4 *tavel(iplon,lay) )
      
         end if
! 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)

! End layer loop
       end do

! End column loop
      end do
!$acc end kernels
#ifndef _ACCEL
#  undef ncol
#endif

end subroutine setcoef_sw

!***************************************************************************
      subroutine swatmref
!***************************************************************************

      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  /)

      end subroutine swatmref

      end module rrtmg_sw_setcoef_f

      module rrtmg_sw_taumol_f

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

      use rrsw_con_f, only: oneminus
      use rrsw_wvn_f, only: nspa, nspb
      use rrsw_vsn_f, only: hvrtau, hnamtau

      implicit none

      contains

!----------------------------------------------------------------------------
      subroutine taumol_sw(ncol, nlayers, &
                           colh2o, colco2, colch4, colo2, colo3, colmol, &
                           laytrop, jp, jt, jt1, &
                           fac00, fac01, fac10, fac11, &
                           selffac, selffrac, indself, forfac, forfrac, indfor, &
                           sfluxzen, taug, taur)
!----------------------------------------------------------------------------

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

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real , intent(inout) gpu_device :: sfluxzen(:,:)   ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real , intent(inout) gpu_device :: taug(:,:,:)     ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real , intent(inout) gpu_device :: taur(:,:,:)     ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Calculate gaseous optical depth and planck fractions for each spectral band.

      call taumol16(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol17(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol18(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol19(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol20(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol21(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol22(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol23(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol24(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol25(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol26(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol27(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol28(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      call taumol29(ncol, nlayers, &
                    colh2o, colco2, colch4, colo2, colo3, colmol, &
                    laytrop, jp, jt, jt1, &
                    fac00, fac01, fac10, fac11, &
                    selffac, selffrac, indself, forfac, forfrac, indfor, &
                    sfluxzen, taug, taur)

      end subroutine


!----------------------------------------------------------------------------
      subroutine taumol16(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 16:  2600-3250 cm-1 (low - h2o,ch4; high - ch4)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng16
      use rrsw_kg16_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, rayl, layreffr, strrat1
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , & 
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(inout) gpu_device :: sfluxzen(:,:)    ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(inout) gpu_device :: taug(:,:,:)             ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(inout) gpu_device :: taur(:,:,:)             ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
# define IKLOOP1_S do iplon=1,ncol;do lay=1,nlayers
# define IKLOOP1_E enddo;enddo
# define IKLOOP2_S do iplon=1,ncol;laysolfr=nlayers;do lay=laytrop(iplon)+1,nlayers;if(jp(iplon,lay-1).lt.layreffr.and.jp(iplon,lay).ge.layreffr)laysolfr=lay
# define IKLOOP2_E
#else
# define ncol CHNK
# define IKLOOP1_S do lay = 1, nlayers ; do iplon = 1, ncol
# define IKLOOP1_E enddo;enddo
# define IKLOOP2_S do lay=2,nlayers;do iplon=1,ncol;if(lay>laytrop(iplon))then;laysolfr=nlayers
# define IKLOOP2_E endif;enddo;enddo
#endif


      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                       fac110, fac111, fs, speccomb, specmult, specparm, &
                       tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                          layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                       fac110, fac111, fs, speccomb, specmult, specparm, &
!                       tauray, strrat1
      integer :: iplon
!      strrat1 = 252.131 
!      layreffr = 18
!$acc kernels 
#ifdef _ACCEL
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure),
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.

! Lower atmosphere loop
      do lay = 1, nlayers
#else
IKLOOP1_S
#endif
         if (lay <= laytrop(iplon)) then
         speccomb = colh2o(iplon,lay)  + strrat1*colch4(iplon,lay)
         specparm = colh2o(iplon,lay) /speccomb
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay)
         fac010 = (1.  - fs) * fac10(iplon,lay)
         fac100 = fs * fac00(iplon,lay)
         fac110 = fs * fac10(iplon,lay)
         fac001 = (1.  - fs) * fac01(iplon,lay)
         fac011 = (1.  - fs) * fac11(iplon,lay)
         fac101 = fs * fac01(iplon,lay)
         fac111 = fs * fac11(iplon,lay)
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(16) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(16) + js
         inds = indself(iplon,lay)
         indf = indfor(iplon,lay)
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng16
            taug(iplon,lay,ig)  = speccomb * &
                (fac000 * absa(ind0   ,ig) + &
                 fac100 * absa(ind0 +1,ig) + &
                 fac010 * absa(ind0 +9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1   ,ig) + &
                 fac101 * absa(ind1 +1,ig) + &
                 fac011 * absa(ind1 +9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colh2o(iplon,lay)  * &
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) 
!            ssa(lay,ig) = tauray/taug(lay,ig)
            taur(iplon,lay,ig)  = tauray
         enddo
         end if
#ifdef _ACCEL
      enddo
      enddo
!$acc end kernels

! Upper atmosphere loop
!$acc kernels 
      do iplon=1,ncol
        laysolfr = nlayers
! mji - fix for out of bounds issue on absb - added to pass bounds checking; FINAL
      do lay = laytrop(iplon)+1, nlayers
!        if (lay > laytrop(iplon)) then
!          !do lay = laytrop(iplon) +1, nlayers
         if (jp(iplon,lay-1)  .lt. layreffr .and. jp(iplon,lay)  .ge.  layreffr) then
            laysolfr = lay
         end if
#else
IKLOOP1_E
IKLOOP2_S
#endif

!#ifdef _ACCEL
!      do iplon=1,ncol
!        laysolfr = nlayers
!! mji - fix for out of bounds issue on absb - added to pass bounds checking; FINAL
!      do lay = laytrop(iplon)+1, nlayers
!!        if (lay > laytrop(iplon)) then
!!          !do lay = laytrop(iplon) +1, nlayers
!         if (jp(iplon,lay-1)  .lt. layreffr .and. jp(iplon,lay)  .ge. layreffr) then
!            laysolfr = lay
!         end if
!#else
!      do lay = minval(laytrop(1:ncol)),nlayers
!       do iplon=1,ncol
!        if (lay > laytrop(iplon)) then
!         laysolfr = nlayers
!
!#endif
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(16) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(16) + 1
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng16
            taug(iplon,lay,ig)  = colch4(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0  ,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1  ,ig) + &
                 fac11(iplon,lay)  * absb(ind1+1,ig)) 

            if (laysolfr == lay) sfluxzen(iplon,ig)  = sfluxref(ig) 
            taur(iplon,lay,ig)  = tauray  
         enddo
#ifdef _ACCEL
         enddo
         enddo
#else
IKLOOP2_E
#endif
!$acc end kernels
# undef ncol
 end subroutine taumol16

!----------------------------------------------------------------------------
      subroutine taumol17(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 17:  3250-4000 cm-1 (low - h2o,co2; high - h2o,co2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng17, ngs16
      use rrsw_kg17_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, rayl, layreffr, strrat
!      use rrsw_kg17_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifndef _ACCEL
# define ncol CHNK
#endif

      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                       fac110, fac111, fs, speccomb, specmult, specparm, &
                       tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                          layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                       fac110, fac111, fs, speccomb, specmult, specparm, &
!                       tauray, strrat
      integer :: iplon

!      layreffr = 30
!      strrat = 0.364641 
    
#ifdef _ACCEL
!$acc kernels loop
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

! Lower atmosphere loop
!$acc loop private(js, fs)
      do lay = 1, nlayers 
#else
IKLOOP1_S
#endif
        if (lay <= laytrop(iplon)) then
          !do lay = 1, laytrop(iplon) 
         speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(17) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(17) + js
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng17
            taug(iplon,lay,ngs16+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colh2o(iplon,lay)  * &
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) 
            taur(iplon,lay,ngs16+ig)  = tauray
         enddo

         else
         
        
         speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 4. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(17) + js
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(17) + js
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng17
            taug(iplon,lay,ngs16+ig)  = speccomb * &
                (fac000 * absb(ind0,ig) + &
                 fac100 * absb(ind0+1,ig) + &
                 fac010 * absb(ind0+5,ig) + &
                 fac110 * absb(ind0+6,ig) + &
                 fac001 * absb(ind1,ig) + &
                 fac101 * absb(ind1+1,ig) + &
                 fac011 * absb(ind1+5,ig) + &
                 fac111 * absb(ind1+6,ig)) + &
                 colh2o(iplon,lay)  * &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig))) 
!            ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
           
            taur(iplon,lay,ngs16+ig)  = tauray
         enddo
        endif
      enddo
      enddo
!$acc end kernels

!$acc kernels
#ifdef _ACCEL
      do iplon = 1, ncol
! Upper atmosphere loop
        laysolfr = nlayers
      do lay = 2, nlayers
        if (lay > laytrop(iplon)) then
#else
IKLOOP2_S
#endif
          
        if ((jp(iplon,lay-1)  .lt. layreffr) .and. (jp(iplon,lay)  .ge. layreffr)) then
            laysolfr = lay
        end if
          
        if (lay == laysolfr) then
              
          speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
          specparm = colh2o(iplon,lay) /speccomb 
          if (specparm .ge. oneminus) specparm = oneminus
          specmult = 4. *(specparm)
          js = 1 + int(specmult)
          fs = mod(specmult, 1.  )
          do ig = 1, ng17 
            sfluxzen(iplon,ngs16+ig)  = sfluxref(ig,js) &
               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
          end do
        end if
#ifdef _ACCEL
        end if
      enddo
      enddo
#else
IKLOOP2_E
#endif
!$acc end kernels      
# undef ncol
      end subroutine taumol17

!----------------------------------------------------------------------------
      subroutine taumol18(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 18:  4000-4650 cm-1 (low - h2o,ch4; high - ch4)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng18, ngs17
      use rrsw_kg18_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, rayl, layreffr, strrat
!      use rrsw_kg18_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , & 
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifndef _ACCEL
# define ncol CHNK
#endif

#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                       fac110, fac111, fs, speccomb, specmult, specparm, &
                       tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                          layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                       fac110, fac111, fs, speccomb, specmult, specparm, &
!                       tauray, strrat
      integer :: iplon

    
!      strrat = 38.9589 
!      layreffr = 6
!$acc kernels      

#ifdef _ACCEL
      do iplon = 1, ncol
          laysolfr = laytrop(iplon)
          do lay = 1, laytrop(iplon)
#else
      laysolfr = laytrop
#define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif
              speccomb = colh2o(iplon,lay)  + strrat*colch4(iplon,lay) 
              specparm = colh2o(iplon,lay) /speccomb 
              if (specparm .ge. oneminus) specparm = oneminus
              specmult = 8. *(specparm)
              js = 1 + int(specmult)
              fs = mod(specmult, 1.  )
              if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
              laysolfr = min(lay+1,laytrop(iplon) )
              do ig = 1, ng18
                if (lay .eq. laysolfr) sfluxzen(iplon,ngs17+ig)  = sfluxref(ig,js) &
                  + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
              end do
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
          end do
      end do
!$acc end kernels
      
!$acc kernels 
IKLOOP1_S
        if (lay <= laytrop(iplon)) then
          !do lay = 1, laytrop(iplon) 
       
         speccomb = colh2o(iplon,lay)  + strrat*colch4(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(18) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(18) + js
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng18
            taug(iplon,lay,ngs17+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colh2o(iplon,lay)  * &
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) 
!            ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
        
            taur(iplon,lay,ngs17+ig)  = tauray
         enddo
      
        else

! Upper atmosphere loop
              
!do lay = laytrop(iplon) +1, nlayers
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(18) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(18) + 1
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng18
            taug(iplon,lay,ngs17+ig)  = colch4(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + &	  
                 fac11(iplon,lay)  * absb(ind1+1,ig)) 
!           ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
           taur(iplon,lay,ngs17+ig)  = tauray
         enddo
        end if
IKLOOP1_E       

!$acc end kernels
# undef ncol
      end subroutine taumol18

!----------------------------------------------------------------------------
      subroutine taumol19(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 19:  4650-5150 cm-1 (low - h2o,co2; high - co2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng19, ngs18
      use rrsw_kg19_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, rayl, layreffr, strrat
!      use rrsw_kg19_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
#else
# define ncol CHNK
#endif

#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, strrat
      integer :: iplon

	        
      strrat = 5.49281 
      layreffr = 3      
      
#ifdef _ACCEL
!$acc kernels 
      do iplon=1,ncol

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  
      laysolfr = laytrop(iplon) 
  
! Lower atmosphere loop      
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif
            
        if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
     
         if (lay .eq. laysolfr) then 
                 speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
        
         do ig = 1 , ng19
            sfluxzen(iplon,ngs18+ig)  = sfluxref(ig,js) &
               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
         end do
         endif
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif

      end do
      end do
!$acc end kernels
      
      
!$acc kernels 
IKLOOP1_S

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

! Lower atmosphere loop      
         if (lay <= laytrop(iplon)) then
       
         speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(19) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(19) + js
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1 , ng19
            taug(iplon,lay,ngs18+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colh2o(iplon,lay)  * &
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + & 
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) 
!            ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
            taur(iplon,lay,ngs18+ig)  = tauray   
         enddo
        else

! Upper atmosphere loop
  
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(19) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(19) + 1
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1 , ng19
            taug(iplon,lay,ngs18+ig)  = colco2(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + &
                 fac11(iplon,lay)  * absb(ind1+1,ig)) 
!            ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig) 
            taur(iplon,lay,ngs18+ig)  = tauray   
         enddo
        end if
IKLOOP1_E       
!$acc end kernels
# undef ncol
      end subroutine taumol19

!----------------------------------------------------------------------------
      subroutine taumol20(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 20:  5150-6150 cm-1 (low - h2o; high - h2o)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng20, ngs19
      use rrsw_kg20_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, absch4, rayl, layreffr
!      use rrsw_kg20_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, absch4, rayl

      implicit none

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
      integer :: iplon

!      layreffr = 3        

#ifdef _ACCEL
!$acc kernels loop independent private(laysolfr)
      do iplon = 1, ncol
      laysolfr = laytrop(iplon)
      do lay = 1, laytrop(iplon)
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif

         if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
         if (lay .eq. laysolfr) then 
             do ig = 1, ng20 
                 sfluxzen(iplon,ngs19+ig)  = sfluxref(ig) 
             end do
         end if
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
      end do
      end do
!$acc end kernels
       
!$acc kernels 
IKLOOP1_S
         if (lay <= laytrop(iplon)) then
         
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(20) + 1
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(20) + 1
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng20
            taug(iplon,lay,ngs19+ig)  = colh2o(iplon,lay)  * &
               ((fac00(iplon,lay)  * absa(ind0,ig) + &
                 fac10(iplon,lay)  * absa(ind0+1,ig) + &
                 fac01(iplon,lay)  * absa(ind1,ig) + &
                 fac11(iplon,lay)  * absa(ind1+1,ig)) + &
                 selffac(iplon,lay)  * (selfref(inds,ig) + & 
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) &
                 + colch4(iplon,lay)  * absch4(ig)
!            ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
            taur(iplon,lay,ngs19+ig)  = tauray 
           
         enddo
         else

! Upper atmosphere loop
      
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(20) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(20) + 1
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng20
            taug(iplon,lay,ngs19+ig)  = colh2o(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + &
                 fac11(iplon,lay)  * absb(ind1+1,ig) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) + &
                 colch4(iplon,lay)  * absch4(ig)
!            ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
            taur(iplon,lay,ngs19+ig)  = tauray 
         enddo
         end if
IKLOOP1_E

!$acc end kernels
# undef ncol
      end subroutine taumol20

!----------------------------------------------------------------------------
      subroutine taumol21(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 21:  6150-7700 cm-1 (low - h2o,co2; high - h2o,co2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng21, ngs20
      use rrsw_kg21_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, rayl, layreffr, strrat
!      use rrsw_kg21_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, strrat
      integer :: iplon
        
!      strrat = 0.0045321 
!      layreffr = 8
     
#ifdef _ACCEL
!$acc kernels loop independent private(laysolfr)
      do iplon = 1, ncol
      laysolfr = laytrop(iplon)
      do lay = 1, laytrop(iplon)
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif

         if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
         if (lay .eq. laysolfr) then 
                speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
               do ig = 1, ng21
              sfluxzen(iplon,ngs20+ig)  = sfluxref(ig,js) &
               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
               end do
          end if

#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
      end do
      end do        
!$acc end kernels

! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  
      
! Lower atmosphere loop
        
!$acc kernels 
IKLOOP1_S
         if (lay <= laytrop(iplon)) then
         speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(21) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(21) + js
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng21
            taug(iplon,lay,ngs20+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colh2o(iplon,lay)  * &
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig))))
!            ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
          
            taur(iplon,lay,ngs20+ig)  = tauray
         enddo
        else

! Upper atmosphere loop

         speccomb = colh2o(iplon,lay)  + strrat*colco2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 4. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(21) + js
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(21) + js
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng21
            taug(iplon,lay,ngs20+ig)  = speccomb * &
                (fac000 * absb(ind0,ig) + &
                 fac100 * absb(ind0+1,ig) + &
                 fac010 * absb(ind0+5,ig) + &
                 fac110 * absb(ind0+6,ig) + &
                 fac001 * absb(ind1,ig) + &
                 fac101 * absb(ind1+1,ig) + &
                 fac011 * absb(ind1+5,ig) + &
                 fac111 * absb(ind1+6,ig)) + &
                 colh2o(iplon,lay)  * &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))
!            ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
            taur(iplon,lay,ngs20+ig)  = tauray
         enddo
        end if
IKLOOP1_E
      
!$acc end kernels
# undef ncol
      end subroutine taumol21

!----------------------------------------------------------------------------
      subroutine taumol22(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 22:  7700-8050 cm-1 (low - h2o,o2; high - o2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng22, ngs21
      use rrsw_kg22_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, rayl, layreffr, strrat
!      use rrsw_kg22_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray, o2adj, o2cont
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, o2adj, o2cont, strrat
      integer :: iplon

! The following factor is the ratio of total O2 band intensity (lines 
! and Mate continuum) to O2 band intensity (line only).  It is needed
! to adjust the optical depths since the k's include only lines.
      o2adj = 1.6 
      
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

!      strrat = 0.022708 
!      layreffr = 2
      
#ifdef _ACCEL
!$acc kernels loop independent private(laysolfr)
      do iplon=1,ncol

      laysolfr = laytrop(iplon) 

! Lower atmosphere loop
!$acc loop seq
         do lay = 1, laytrop(iplon) 
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif

            if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
                 
            if (lay .eq. laysolfr) then 
            speccomb = colh2o(iplon,lay)  + o2adj*strrat*colo2(iplon,lay) 
            specparm = colh2o(iplon,lay) /speccomb 
            if (specparm .ge. oneminus) specparm = oneminus
            specmult = 8. *(specparm)
    !         odadj = specparm + o2adj * (1.  - specparm)
            js = 1 + int(specmult)
            fs = mod(specmult, 1.  )
            do ig = 1, ng22                                 
                                 
               sfluxzen(iplon,ngs21+ig)  = sfluxref(ig,js) &
                + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
            end do
            end if
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
         end do
      end do
 !$acc end kernels
 
! Lower atmosphere loop
!$acc kernels 
IKLOOP1_S

         if (lay<=laytrop(iplon)) then
  
         o2cont = 4.35e-4 *colo2(iplon,lay) /(350.0 *2.0 )
         speccomb = colh2o(iplon,lay)  + o2adj*strrat*colo2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
!         odadj = specparm + o2adj * (1.  - specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(22) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(22) + js
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng22
            taug(iplon,lay,ngs21+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colh2o(iplon,lay)  * &
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                  (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) &
                 + o2cont
!            ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)

            taur(iplon,lay,ngs21+ig)  = tauray
         enddo

         else

! Upper atmosphere loop
      
         o2cont = 4.35e-4 *colo2(iplon,lay) /(350.0 *2.0 )
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(22) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(22) + 1
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng22
            taug(iplon,lay,ngs21+ig)  = colo2(iplon,lay)  * o2adj * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + &
                 fac11(iplon,lay)  * absb(ind1+1,ig)) + &
                 o2cont
!            ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
            taur(iplon,lay,ngs21+ig)  = tauray
         enddo
         end if
IKLOOP1_E
      
!$acc end kernels
# undef ncol
      end subroutine taumol22

!----------------------------------------------------------------------------
      subroutine taumol23(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 23:  8050-12850 cm-1 (low - h2o; high - nothing)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng23, ngs22
      use rrsw_kg23_f, only : absa, ka, forref, selfref, &
                            sfluxref, rayl, layreffr, givfac
!      use rrsw_kg23_f, only : absa, ka, forref, selfref, &
!                            sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, givfac
      integer :: iplon


! Average Giver et al. correction factor for this band.
!      givfac = 1.029 

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

!      layreffr = 6    
      
#ifdef _ACCEL
!$acc kernels loop independent private(laysolfr)
      do iplon=1,ncol

      laysolfr = laytrop(iplon) 

! Lower atmosphere loop
!$acc loop seq
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif

          if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
         
          if (lay .eq. laysolfr) then 
            do ig = 1, ng23
              sfluxzen(iplon,ngs22+ig)  = sfluxref(ig) 
            end do
          end if
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
      end do
      end do      
!$acc end kernels   
      

! Lower atmosphere loop
!$acc kernels 
IKLOOP1_S
         if (lay <= laytrop(iplon)) then
         if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(23) + 1
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(23) + 1
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 

         do ig = 1, ng23
            tauray = colmol(iplon,lay)  * rayl(ig)
            taug(iplon,lay,ngs22+ig)  = colh2o(iplon,lay)  * &
                (givfac * (fac00(iplon,lay)  * absa(ind0,ig) + &
                 fac10(iplon,lay)  * absa(ind0+1,ig) + &
                 fac01(iplon,lay)  * absa(ind1,ig) + &
                 fac11(iplon,lay)  * absa(ind1+1,ig)) + &
                 selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + &
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) 
!            ssa(lay,ngs22+ig) = tauray/taug(lay,ngs22+ig)
           
            taur(iplon,lay,ngs22+ig)  = tauray
         enddo

         else

! Upper atmosphere loop
      
         do ig = 1, ng23
!            taug(lay,ngs22+ig) = colmol(lay) * rayl(ig)
!            ssa(lay,ngs22+ig) = 1.0 
            taug(iplon,lay,ngs22+ig)  = 0. 
            taur(iplon,lay,ngs22+ig)  = colmol(iplon,lay)  * rayl(ig) 
         enddo
         end if

IKLOOP1_E
      
!$acc end kernels
# undef ncol
      end subroutine taumol23

!----------------------------------------------------------------------------
      subroutine taumol24(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 24:  12850-16000 cm-1 (low - h2o,o2; high - o2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng24, ngs23
      use rrsw_kg24_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, abso3a, abso3b, rayla, raylb, &
                            layreffr, strrat
!      use rrsw_kg24_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, abso3a, abso3b, rayla, raylb

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , & 
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, strrat
      integer :: iplon

!      strrat = 0.124692 
!      layreffr = 1   
        
#ifdef _ACCEL
!$acc kernels loop independent private(laysolfr)
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

      laysolfr = laytrop(iplon) 

! Lower atmosphere loop
!$acc loop independent
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif

          if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
          if (lay .eq. laysolfr) then
                 speccomb = colh2o(iplon,lay)  + strrat*colo2(iplon,lay) 
            specparm = colh2o(iplon,lay) /speccomb 
            if (specparm .ge. oneminus) specparm = oneminus
            specmult = 8. *(specparm)
            js = 1 + int(specmult)
            fs = mod(specmult, 1.  )
          do ig = 1, ng24
           sfluxzen(iplon,ngs23+ig)  = sfluxref(ig,js) &
               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
          end do
          end if
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
      end do
      end do
!$acc end kernels
        
!$acc kernels 
IKLOOP1_S
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

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

         speccomb = colh2o(iplon,lay)  + strrat*colo2(iplon,lay) 
         specparm = colh2o(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(24) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(24) + js
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 

         do ig = 1, ng24
            tauray = colmol(iplon,lay)  * (rayla(ig,js) + &
               fs * (rayla(ig,js+1) - rayla(ig,js)))
            taug(iplon,lay,ngs23+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) + &
                 colo3(iplon,lay)  * abso3a(ig) + &
                 colh2o(iplon,lay)  * & 
                 (selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + & 
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig))))
!            ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
           
            taur(iplon,lay,ngs23+ig)  = tauray
         enddo

         else

! Upper atmosphere loop
      
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(24) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(24) + 1

         do ig = 1, ng24
            tauray = colmol(iplon,lay)  * raylb(ig)
            taug(iplon,lay,ngs23+ig)  = colo2(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + &
                 fac11(iplon,lay)  * absb(ind1+1,ig)) + &
                 colo3(iplon,lay)  * abso3b(ig)
!            ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
            taur(iplon,lay,ngs23+ig)  = tauray
         enddo
         endif

IKLOOP1_E
      
!$acc end kernels
# undef ncol
      end subroutine taumol24

!----------------------------------------------------------------------------
      subroutine taumol25(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 25:  16000-22650 cm-1 (low - h2o; high - nothing)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng25, ngs24
      use rrsw_kg25_f, only : absa, ka, &
                            sfluxref, abso3a, abso3b, rayl, layreffr
!      use rrsw_kg25_f, only : absa, ka, &
!                            sfluxref, abso3a, abso3b, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif


!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
      integer :: iplon

#ifdef _ACCEL
!$acc kernels 
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

!      layreffr = 2
      laysolfr = laytrop(iplon) 

! Lower atmosphere loop
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif
         if (jp(iplon,lay)  .lt. layreffr .and. jp(iplon,lay+1)  .ge. layreffr) &
            laysolfr = min(lay+1,laytrop(iplon) )
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(25) + 1
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(25) + 1

         do ig = 1, ng25
            tauray = colmol(iplon,lay)  * rayl(ig)
            taug(iplon,lay,ngs24+ig)  = colh2o(iplon,lay)  * &
                (fac00(iplon,lay)  * absa(ind0,ig) + &
                 fac10(iplon,lay)  * absa(ind0+1,ig) + &
                 fac01(iplon,lay)  * absa(ind1,ig) + &
                 fac11(iplon,lay)  * absa(ind1+1,ig)) + &
                 colo3(iplon,lay)  * abso3a(ig) 
!            ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
            if (lay .eq. laysolfr) sfluxzen(iplon,ngs24+ig)  = sfluxref(ig) 
            taur(iplon,lay,ngs24+ig)  = tauray
         enddo
#ifdef _ACCEL
      enddo
! Upper atmosphere loop
      do lay = laytrop(iplon) +1, nlayers
#else
      else 
#endif

         do ig = 1, ng25
            tauray = colmol(iplon,lay)  * rayl(ig)
            taug(iplon,lay,ngs24+ig)  = colo3(iplon,lay)  * abso3b(ig) 
!            ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
            taur(iplon,lay,ngs24+ig)  = tauray
         enddo
#ifdef _ACCEL
#else
# undef laysolfr
      endif
#endif
      enddo
      enddo
      
!$acc end kernels
# undef ncol
      end subroutine taumol25

!----------------------------------------------------------------------------
      subroutine taumol26(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 26:  22650-29000 cm-1 (low - nothing; high - nothing)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng26, ngs25
      use rrsw_kg26_f, only : sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
      integer :: iplon

#ifdef _ACCEL
!$acc kernels 
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

      laysolfr = laytrop(iplon) 

! Lower atmosphere loop
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = laytrop
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif
         do ig = 1, ng26 
!            taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
!            ssa(lay,ngs25+ig) = 1.0 
            if (lay .eq. laysolfr) sfluxzen(iplon,ngs25+ig)  = sfluxref(ig) 
            taug(iplon,lay,ngs25+ig)  = 0. 
            taur(iplon,lay,ngs25+ig)  = colmol(iplon,lay)  * rayl(ig) 
         enddo
#ifdef _ACCEL
      enddo
      do lay = laytrop(iplon) +1, nlayers
#else
      else
#endif

! Upper atmosphere loop
         do ig = 1, ng26
!            taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
!            ssa(lay,ngs25+ig) = 1.0 
            taug(iplon,lay,ngs25+ig)  = 0. 
            taur(iplon,lay,ngs25+ig)  = colmol(iplon,lay)  * rayl(ig) 
         enddo
#ifdef _ACCEL
#else
# undef laysolfr
      endif
#endif
      enddo
      enddo
      
!$acc end kernels
# undef ncol
      end subroutine taumol26

!----------------------------------------------------------------------------
      subroutine taumol27(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 27:  29000-38000 cm-1 (low - o3; high - o3)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng27, ngs26
      use rrsw_kg27_f, only : absa, ka, absb, kb, &
                            sfluxref, rayl, layreffr, scalekur
!      use rrsw_kg27_f, only : absa, ka, absb, kb, sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, scalekur
      integer :: iplon
       
#ifdef _ACCEL
!$acc kernels 
      do iplon=1,ncol
! Kurucz solar source function
! The values in sfluxref were obtained using the "low resolution"
! version of the Kurucz solar source function.  For unknown reasons,
! the total irradiance in this band differs from the corresponding
! total in the "high-resolution" version of the Kurucz function.
! Therefore, these values are scaled below by the factor SCALEKUR.

!      scalekur = 50.15 /48.37 

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

!      layreffr = 32

! Lower atmosphere loop
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = nlayers
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(27) + 1
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(27) + 1

         do ig = 1, ng27
            tauray = colmol(iplon,lay)  * rayl(ig)
            taug(iplon,lay,ngs26+ig)  = colo3(iplon,lay)  * &
                (fac00(iplon,lay)  * absa(ind0,ig) + &
                 fac10(iplon,lay)  * absa(ind0+1,ig) + &
                 fac01(iplon,lay)  * absa(ind1,ig) + &
                 fac11(iplon,lay)  * absa(ind1+1,ig))
!            ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
            taur(iplon,lay,ngs26+ig)  = tauray
         enddo
#ifdef _ACCEL
      enddo

      laysolfr = nlayers

! Upper atmosphere loop
      do lay = laytrop(iplon) +1, nlayers
#else
      else
#endif
         if (jp(iplon,lay-1)  .lt. layreffr .and. jp(iplon,lay)  .ge. layreffr) &
            laysolfr = lay
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(27) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(27) + 1

         do ig = 1, ng27
            tauray = colmol(iplon,lay)  * rayl(ig)
            taug(iplon,lay,ngs26+ig)  = colo3(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + & 
                 fac11(iplon,lay)  * absb(ind1+1,ig))
!            ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
            if (lay.eq.laysolfr) sfluxzen(iplon,ngs26+ig)  = scalekur * sfluxref(ig) 
            taur(iplon,lay,ngs26+ig)  = tauray
         enddo
#ifdef _ACCEL
#else
# undef laysolfr
      endif
#endif
      enddo
      enddo
      
!$acc end kernels
# undef ncol
      end subroutine taumol27

!----------------------------------------------------------------------------
      subroutine taumol28(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 28:  38000-50000 cm-1 (low - o3,o2; high - o3,o2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng28, ngs27
      use rrsw_kg28_f, only : absa, ka, absb, kb, &
                            sfluxref, rayl, layreffr, strrat
!      use rrsw_kg28_f, only : absa, ka, absb, kb, sfluxref, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , & 
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
!      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
!                  fac110, fac111, fs, speccomb, specmult, specparm, &
!                  tauray, strrat
      integer :: iplon

#ifdef _ACCEL
!$acc kernels 
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

!      strrat = 6.67029e-07 
!      layreffr = 58

! Lower atmosphere loop
      do lay = 1, laytrop(iplon) 
#else
      laysolfr = nlayers
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay <= laytrop(iplon)) then
#endif
         speccomb = colo3(iplon,lay)  + strrat*colo2(iplon,lay) 
         specparm = colo3(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 8. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(28) + js
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(28) + js
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng28
            taug(iplon,lay,ngs27+ig)  = speccomb * &
                (fac000 * absa(ind0,ig) + &
                 fac100 * absa(ind0+1,ig) + &
                 fac010 * absa(ind0+9,ig) + &
                 fac110 * absa(ind0+10,ig) + &
                 fac001 * absa(ind1,ig) + &
                 fac101 * absa(ind1+1,ig) + &
                 fac011 * absa(ind1+9,ig) + &
                 fac111 * absa(ind1+10,ig)) 
!            ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
            taur(iplon,lay,ngs27+ig)  = tauray
         enddo
#ifdef _ACCEL
      enddo

      laysolfr = nlayers

! Upper atmosphere loop
      do lay = laytrop(iplon) +1, nlayers
#else
      else
#endif
         if (jp(iplon,lay-1)  .lt. layreffr .and. jp(iplon,lay)  .ge. layreffr) &
            laysolfr = lay
         speccomb = colo3(iplon,lay)  + strrat*colo2(iplon,lay) 
         specparm = colo3(iplon,lay) /speccomb 
         if (specparm .ge. oneminus) specparm = oneminus
         specmult = 4. *(specparm)
         js = 1 + int(specmult)
         fs = mod(specmult, 1.  )
         fac000 = (1.  - fs) * fac00(iplon,lay) 
         fac010 = (1.  - fs) * fac10(iplon,lay) 
         fac100 = fs * fac00(iplon,lay) 
         fac110 = fs * fac10(iplon,lay) 
         fac001 = (1.  - fs) * fac01(iplon,lay) 
         fac011 = (1.  - fs) * fac11(iplon,lay) 
         fac101 = fs * fac01(iplon,lay) 
         fac111 = fs * fac11(iplon,lay) 
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(28) + js
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(28) + js
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng28
            taug(iplon,lay,ngs27+ig)  = speccomb * &
                (fac000 * absb(ind0,ig) + &
                 fac100 * absb(ind0+1,ig) + &
                 fac010 * absb(ind0+5,ig) + &
                 fac110 * absb(ind0+6,ig) + &
                 fac001 * absb(ind1,ig) + &
                 fac101 * absb(ind1+1,ig) + &
                 fac011 * absb(ind1+5,ig) + &
                 fac111 * absb(ind1+6,ig)) 
!            ssa(lay,ngs27+ig) = tauray/taug(lay,ngs27+ig)
            if (lay .eq. laysolfr) sfluxzen(iplon,ngs27+ig)  = sfluxref(ig,js) &
               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
            taur(iplon,lay,ngs27+ig)  = tauray
         enddo
#ifdef _ACCEL
#else
# undef laysolfr
      endif
#endif
      enddo
      enddo
      
!$acc end kernels
# undef ncol
      end subroutine taumol28

!----------------------------------------------------------------------------
      subroutine taumol29(ncol, nlayers, &
                          colh2o, colco2, colch4, colo2, colo3, colmol, &
                          laytrop, jp, jt, jt1, &
                          fac00, fac01, fac10, fac11, &
                          selffac, selffrac, indself, forfac, forfrac, indfor, &
                          sfluxzen, taug, taur)
!----------------------------------------------------------------------------
!
!     band 29:  820-2600 cm-1 (low - h2o; high - co2)
!
!----------------------------------------------------------------------------

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

      use parrrsw_f, only : ng29, ngs28
      use rrsw_kg29_f, only : absa, ka, absb, kb, forref, selfref, &
                            sfluxref, absh2o, absco2, rayl, layreffr
!      use rrsw_kg29_f, only : absa, ka, absb, kb, forref, selfref, &
!                            sfluxref, absh2o, absco2, rayl

! ------- Declarations -------
      integer , intent(in) :: ncol
      integer , intent(in) :: nlayers               ! total number of layers

      integer , intent(in) :: laytrop(:)            ! tropopause layer index
      integer , intent(in) :: jp(:,:)               ! 
      integer , intent(in) :: jt(:,:)               !
      integer , intent(in) :: jt1(:,:)              !
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: colh2o(:,:)              ! column amount (h2o)
      real , intent(in) :: colco2(:,:)              ! column amount (co2)
      real , intent(in) :: colo3(:,:)               ! column amount (o3)
      real , intent(in) :: colch4(:,:)              ! column amount (ch4)
      real , intent(in) :: colo2(:,:)               ! column amount (o2)
      real , intent(in) :: colmol(:,:)              ! 
                                                    !   Dimensions: (ncol,nlayers)

      integer , intent(in) :: indself(:,:)     
      integer , intent(in) :: indfor(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
                                                    !   Dimensions: (ncol,nlayers)

      real , intent(in) :: &                        !
                       fac00(:,:) , fac01(:,:) , &  
                       fac10(:,:) , fac11(:,:)  
                                                    !   Dimensions: (ncol,nlayers)

! ----- Output -----
      real, intent(out) gpu_device :: sfluxzen(:,:)      ! solar source function
                                                         !   Dimensions: (ncol,ngptsw)
      real, intent(out) gpu_device :: taug(:,:,:)        ! gaseous optical depth 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)
      real, intent(out) gpu_device :: taur(:,:,:)        ! Rayleigh 
                                                         !   Dimensions: (ncol,nlayers,ngptsw)

! Local
#ifdef _ACCEL
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
#else
# define ncol CHNK
      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr(ncol)
#endif

!      integer  :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
!                  layreffr
      real  :: fac000, fac001, fac010, fac011, fac100, fac101, &
                  fac110, fac111, fs, speccomb, specmult, specparm, &
                  tauray
      integer :: iplon

!      layreffr = 49  
        
#ifdef _ACCEL
!$acc kernels loop independent private (laysolfr)
      do iplon=1,ncol
        
        laysolfr = nlayers
!$acc loop seq
        do lay = laytrop(iplon) +1, nlayers
#else
      laysolfr = nlayers
# define laysolfr LAYSOLFR(iplon)
      do lay = 1, nlayers
        do iplon = 1, ncol
          if (lay > laytrop(iplon)) then
#endif
         if (jp(iplon,lay-1)  .lt. layreffr .and. jp(iplon,lay)  .ge. layreffr) &
            laysolfr = lay

            if (lay .eq. laysolfr) then 
                do ig = 1, ng29
                sfluxzen(iplon,ngs28+ig)  = sfluxref(ig) 
                end do
            end if
#ifdef _ACCEL
#else
# undef laysolfr
         endif
#endif
        end do
      end do
!$acc end kernels
       
#ifdef _ACCEL
!$acc kernels 
      do iplon=1,ncol
! Compute the optical depth by interpolating in ln(pressure), 
! temperature, and appropriate species.  Below LAYTROP, the water
! vapor self-continuum is interpolated (in temperature) separately.  

! Lower atmosphere loop
      do lay = 1, nlayers 
#else
    do lay = 1, nlayers 
      do iplon=1,ncol
#endif
         if (lay <= laytrop(iplon)) then
         ind0 = ((jp(iplon,lay) -1)*5+(jt(iplon,lay) -1))*nspa(29) + 1
         ind1 = (jp(iplon,lay) *5+(jt1(iplon,lay) -1))*nspa(29) + 1
         inds = indself(iplon,lay) 
         indf = indfor(iplon,lay) 
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng29
            taug(iplon,lay,ngs28+ig)  = colh2o(iplon,lay)  * &
               ((fac00(iplon,lay)  * absa(ind0,ig) + &
                 fac10(iplon,lay)  * absa(ind0+1,ig) + &
                 fac01(iplon,lay)  * absa(ind1,ig) + &
                 fac11(iplon,lay)  * absa(ind1+1,ig)) + &
                 selffac(iplon,lay)  * (selfref(inds,ig) + &
                 selffrac(iplon,lay)  * &
                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
                 forfac(iplon,lay)  * (forref(indf,ig) + & 
                 forfrac(iplon,lay)  * &
                 (forref(indf+1,ig) - forref(indf,ig)))) &
                 + colco2(iplon,lay)  * absco2(ig) 
!            ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
            taur(iplon,lay,ngs28+ig)  = tauray
         enddo

         else 

! Upper atmosphere loop
         ind0 = ((jp(iplon,lay) -13)*5+(jt(iplon,lay) -1))*nspb(29) + 1
         ind1 = ((jp(iplon,lay) -12)*5+(jt1(iplon,lay) -1))*nspb(29) + 1
         tauray = colmol(iplon,lay)  * rayl

         do ig = 1, ng29
            taug(iplon,lay,ngs28+ig)  = colco2(iplon,lay)  * &
                (fac00(iplon,lay)  * absb(ind0,ig) + &
                 fac10(iplon,lay)  * absb(ind0+1,ig) + &
                 fac01(iplon,lay)  * absb(ind1,ig) + &
                 fac11(iplon,lay)  * absb(ind1+1,ig)) &  
                 + colh2o(iplon,lay)  * absh2o(ig) 
!            ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
        
            taur(iplon,lay,ngs28+ig)  = tauray
         enddo
         end if

      enddo
      enddo
      
!$acc end kernels
# undef ncol
      end subroutine taumol29

# undef IKLOOP1_S
# undef IKLOOP1_E
# undef IKLOOP2_S 
# undef IKLOOP2_E

      end module rrtmg_sw_taumol_f

      module rrtmg_sw_init_f

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

      use rrsw_wvn_f
      use rrtmg_sw_setcoef_f, only: swatmref
      
      implicit none

      public rrtmg_sw_ini
      
      contains

! **************************************************************************
      subroutine rrtmg_sw_ini(cpdair)
! **************************************************************************
!
!  Original version:   Michael J. Iacono; February, 2004
!  Revision for F90 formatting:  M. J. Iacono, July, 2006
!
!  This subroutine performs calculations necessary for the initialization
!  of the shortwave model.  Lookup tables are computed for use in the SW
!  radiative transfer, and input absorption coefficient data for each
!  spectral band are reduced from 224 g-point intervals to 112.
! **************************************************************************

      use parrrsw_f, only : mg, nbndsw, ngptsw
      use rrsw_tbl_f, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl
      use rrsw_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  :: ibnd, igc, ig, ind, ipr
      integer  :: igcsm, iprsm
      integer  :: itr

      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 
!     EXP_TBL  Exponential lookup table for transmittance
!     PADE     Pade approximation constant (= 0.278)
!     BPADE    Inverse of the Pade approximation constant
!

      hvrini = '$Revision: 1.5 $'

! Initialize model data
      call swdatinit(cpdair)
      call swcmbdat              ! g-point interval reduction data
      call swaerpr               ! aerosol optical properties
      call swcldpr               ! cloud optical properties
      call swatmref              ! reference MLS profile
! Moved to module_ra_rrtmg_swf for WRF
!      call sw_kgb16              ! molecular absorption coefficients
!      call sw_kgb17
!      call sw_kgb18
!      call sw_kgb19
!      call sw_kgb20
!      call sw_kgb21
!      call sw_kgb22
!      call sw_kgb23
!      call sw_kgb24
!      call sw_kgb25
!      call sw_kgb26
!      call sw_kgb27
!      call sw_kgb28
!      call sw_kgb29

! Define exponential lookup tables for transmittance. Tau is
! computed as a function of the tau transition function, and transmittance 
! is calculated as a function of tau.  All tables are computed at intervals 
! of 0.0001.  The inverse of the constant used in the Pade approximation to 
! the tau transition function is set to bpade.

      exp_tbl(0) = 1.0 
      exp_tbl(ntbl) = expeps
      bpade = 1.0  / pade
      do itr = 1, ntbl-1
         tfn = float(itr) / float(ntbl)
         tau_tbl = bpade * tfn / (1.  - tfn)
         exp_tbl(itr) = exp(-tau_tbl)
         if (exp_tbl(itr) .le. expeps) exp_tbl(itr) = expeps
      enddo

! Perform g-point reduction from 16 per band (224 total points) to
! a band dependent number (112 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,nbndsw
         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+15)
               ind = (ibnd-1)*mg + ig
               rwgt(ind) = wt(ig)/wtsm(ngm(ind))
            enddo
         else
            do ig = 1, ng(ibnd+15)
               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 cmbgb16s
      call cmbgb17
      call cmbgb18
      call cmbgb19
      call cmbgb20
      call cmbgb21
      call cmbgb22
      call cmbgb23
      call cmbgb24
      call cmbgb25
      call cmbgb26
      call cmbgb27
      call cmbgb28
      call cmbgb29

      end subroutine rrtmg_sw_ini

!***************************************************************************
      subroutine swdatinit(cpdair)
!***************************************************************************

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

      use rrsw_con_f, only: heatfac, grav, planck, boltz, &
                          clight, avogad, alosmt, gascon, radcn1, radcn2, &
                          sbcnst, secdy 
      use rrsw_vsn_f

      save 
 
      real , intent(in) :: cpdair     ! Specific heat capacity of dry air
                                      ! at constant pressure at 273 K
                                      ! (J kg-1 K-1)

! Shortwave spectral band limits (wavenumbers)
      wavenum1(:) = (/2600. , 3250. , 4000. , 4650. , 5150. , 6150. , 7700. , &
                      8050. ,12850. ,16000. ,22650. ,29000. ,38000. ,  820. /)
      wavenum2(:) = (/3250. , 4000. , 4650. , 5150. , 6150. , 7700. , 8050. , &
                     12850. ,16000. ,22650. ,29000. ,38000. ,50000. , 2600. /)
      delwave(:) =  (/ 650. ,  750. ,  650. ,  500. , 1000. , 1550. ,  350. , &
                      4800. , 3150. , 6650. , 6350. , 9000. ,12000. , 1780. /)
     
! Spectral band information
      ng(:) = (/16,16,16,16,16,16,16,16,16,16,16,16,16,16/)
      nspa(:) = (/9,9,9,9,1,9,9,1,9,1,0,1,9,1/)
      nspb(:) = (/1,5,1,1,1,5,1,0,1,0,0,1,5,1/)
      icxa(:) = (/ 5 ,5 ,4 ,4 ,3 ,3 ,2 ,2 ,1 ,1 ,1 ,1 ,1 ,5/)

! 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.191042772e-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 (from constants above and input cpdair)
!        (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 swdatinit

!***************************************************************************
      subroutine swcmbdat
!***************************************************************************

      save
 
! ------- Definitions -------
!     Arrays for the g-point reduction from 224 to 112 for the 16 LW bands:
!     This mapping from 224 to 112 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 224
!     g-point set can be restored with ngpt=224, ngc=16*16, ngn=224*1., etc.
!     ngpt    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.

! Use this set for 112 quadrature point (g-point) model
! ------- Data statements -------
      ngc(:) = (/ 6,12, 8, 8,10,10, 2,10, 8, 6, 6, 8, 6,12 /)
      ngs(:) = (/ 6,18,26,34,44,54,56,66,74,80,86,94,100,112 /)
      ngm(:) = (/ 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, &           ! band 16
                  1,2,3,4,5,6,6,7,8,8,9,10,10,11,12,12, &      ! band 17
                  1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &           ! band 18
                  1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &           ! band 19
                  1,2,3,4,5,6,7,8,9,9,10,10,10,10,10,10, &     ! band 20
                  1,2,3,4,5,6,7,8,9,9,10,10,10,10,10,10, &     ! band 21
                  1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &           ! band 22
                  1,1,2,2,3,4,5,6,7,8,9,9,10,10,10,10, &       ! band 23
                  1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &           ! band 24
                  1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, &           ! band 25
                  1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, &           ! band 26
                  1,2,3,4,5,6,7,7,7,7,8,8,8,8,8,8, &           ! band 27
                  1,2,3,3,4,4,5,5,5,5,6,6,6,6,6,6, &           ! band 28
                  1,2,3,4,5,5,6,6,7,7,8,8,9,10,11,12 /)        ! band 29
      ngn(:) = (/ 2,2,2,2,4,4, &                               ! band 16
                  1,1,1,1,1,2,1,2,1,2,1,2, &                   ! band 17
                  1,1,1,1,2,2,4,4, &                           ! band 18
                  1,1,1,1,2,2,4,4, &                           ! band 19
                  1,1,1,1,1,1,1,1,2,6, &                       ! band 20
                  1,1,1,1,1,1,1,1,2,6, &                       ! band 21
                  8,8, &                                       ! band 22
                  2,2,1,1,1,1,1,1,2,4, &                       ! band 23
                  2,2,2,2,2,2,2,2, &                           ! band 24
                  1,1,2,2,4,6, &                               ! band 25
                  1,1,2,2,4,6, &                               ! band 26
                  1,1,1,1,1,1,4,6, &                           ! band 27
                  1,1,2,2,4,6, &                               ! band 28
                  1,1,1,1,2,2,2,2,1,1,1,1 /)                   ! band 29
      ngb(:) = (/ 16,16,16,16,16,16, &                         ! band 16
                  17,17,17,17,17,17,17,17,17,17,17,17, &       ! band 17
                  18,18,18,18,18,18,18,18, &                   ! band 18
                  19,19,19,19,19,19,19,19, &                   ! band 19
                  20,20,20,20,20,20,20,20,20,20, &             ! band 20
                  21,21,21,21,21,21,21,21,21,21, &             ! band 21
                  22,22, &                                     ! band 22
                  23,23,23,23,23,23,23,23,23,23, &             ! band 23
                  24,24,24,24,24,24,24,24, &                   ! band 24
                  25,25,25,25,25,25, &                         ! band 25
                  26,26,26,26,26,26, &                         ! band 26
                  27,27,27,27,27,27,27,27, &                   ! band 27
                  28,28,28,28,28,28, &                         ! band 28
                  29,29,29,29,29,29,29,29,29,29,29,29 /)       ! band 29

! Use this set for full 224 quadrature point (g-point) model
! ------- Data statements -------
!      ngc(:) = (/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16 /)
!      ngs(:) = (/ 16,32,48,64,80,96,112,128,144,160,176,192,208,224 /)
!      ngm(:) = (/ 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 16
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 17
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 18
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 19
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 20
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 21
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 22
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 23
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 24
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 25
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 26
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 27
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 28
!                  1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /)    ! band 29
!      ngn(:) = (/ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 16
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 17
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 18
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 19
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 20
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 21
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 22
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 23
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 24
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 25
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 26
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 27
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 28
!                  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 /)           ! band 29
!      ngb(:) = (/ 16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16, &   ! band 16
!                  17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17, &   ! band 17
!                  18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18, &   ! band 18
!                  19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19, &   ! band 19
!                  20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20, &   ! band 20
!                  21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21, &   ! band 21
!                  22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22, &   ! band 22
!                  23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, &   ! band 23
!                  24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, &   ! band 24
!                  25,25,25,25,25,25,25,25,25,25,25,25,25,25,25,25, &   ! band 25
!                  26,26,26,26,26,26,26,26,26,26,26,26,26,26,26,26, &   ! band 26
!                  27,27,27,27,27,27,27,27,27,27,27,27,27,27,27,27, &   ! band 27
!                  28,28,28,28,28,28,28,28,28,28,28,28,28,28,28,28, &   ! band 28
!                  29,29,29,29,29,29,29,29,29,29,29,29,29,29,29,29 /)   ! band 29


      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 swcmbdat

!***************************************************************************
      subroutine swaerpr
!***************************************************************************

! Purpose: Define spectral aerosol properties for six ECMWF aerosol types
! as used in the ECMWF IFS model (see module rrsw_aer.F90 for details)
!
! Original: Defined for rrtmg_sw 14 spectral bands, JJMorcrette, ECMWF Feb 2003
! Revision: Reformatted for consistency with rrtmg_lw, MJIacono, AER, Jul 2006

      use rrsw_aer_f, only : rsrtaua, rsrpiza, rsrasya

      save

      rsrtaua( 1, :) = (/ &
        0.10849 , 0.66699 , 0.65255 , 0.11600 , 0.06529 , 0.04468 /)
      rsrtaua( 2, :) = (/ &
        0.10849 , 0.66699 , 0.65255 , 0.11600 , 0.06529 , 0.04468 /)
      rsrtaua( 3, :) = (/ &
        0.20543 , 0.84642 , 0.84958 , 0.21673 , 0.28270 , 0.10915 /)
      rsrtaua( 4, :) = (/ &
        0.20543 , 0.84642 , 0.84958 , 0.21673 , 0.28270 , 0.10915 /)
      rsrtaua( 5, :) = (/ &
        0.20543 , 0.84642 , 0.84958 , 0.21673 , 0.28270 , 0.10915 /)
      rsrtaua( 6, :) = (/ &
        0.20543 , 0.84642 , 0.84958 , 0.21673 , 0.28270 , 0.10915 /)
      rsrtaua( 7, :) = (/ &
        0.20543 , 0.84642 , 0.84958 , 0.21673 , 0.28270 , 0.10915 /)
      rsrtaua( 8, :) = (/ &
        0.52838 , 0.93285 , 0.93449 , 0.53078 , 0.67148 , 0.46608 /)
      rsrtaua( 9, :) = (/ &
        0.52838 , 0.93285 , 0.93449 , 0.53078 , 0.67148 , 0.46608 /)
      rsrtaua(10, :) = (/ &
        1.69446 , 1.11855 , 1.09212 , 1.72145 , 1.03858 , 1.12044 /)
      rsrtaua(11, :) = (/ &
        1.69446 , 1.11855 , 1.09212 , 1.72145 , 1.03858 , 1.12044 /)
      rsrtaua(12, :) = (/ &
        1.69446 , 1.11855 , 1.09212 , 1.72145 , 1.03858 , 1.12044 /)
      rsrtaua(13, :) = (/ &
        1.69446 , 1.11855 , 1.09212 , 1.72145 , 1.03858 , 1.12044 /)
      rsrtaua(14, :) = (/ &
        0.10849 , 0.66699 , 0.65255 , 0.11600 , 0.06529 , 0.04468 /)
 
      rsrpiza( 1, :) = (/ &
        .5230504 , .7868518 , .8531531 , .4048149 , .8748231 , .2355667 /)
      rsrpiza( 2, :) = (/ &
        .5230504 , .7868518 , .8531531 , .4048149 , .8748231 , .2355667 /)
      rsrpiza( 3, :) = (/ &
        .8287144 , .9949396 , .9279543 , .6765051 , .9467578 , .9955938 /)
      rsrpiza( 4, :) = (/ &
        .8287144 , .9949396 , .9279543 , .6765051 , .9467578 , .9955938 /)
      rsrpiza( 5, :) = (/ &
        .8287144 , .9949396 , .9279543 , .6765051 , .9467578 , .9955938 /)
      rsrpiza( 6, :) = (/ &
        .8287144 , .9949396 , .9279543 , .6765051 , .9467578 , .9955938 /)
      rsrpiza( 7, :) = (/ &
        .8287144 , .9949396 , .9279543 , .6765051 , .9467578 , .9955938 /)
      rsrpiza( 8, :) = (/ &
        .8970131 , .9984940 , .9245594 , .7768385 , .9532763 , .9999999 /)
      rsrpiza( 9, :) = (/ &
        .8970131 , .9984940 , .9245594 , .7768385 , .9532763 , .9999999 /)
      rsrpiza(10, :) = (/ &
        .9148907 , .9956173 , .7504584 , .8131335 , .9401905 , .9999999 /)
      rsrpiza(11, :) = (/ &
        .9148907 , .9956173 , .7504584 , .8131335 , .9401905 , .9999999 /)
      rsrpiza(12, :) = (/ &
        .9148907 , .9956173 , .7504584 , .8131335 , .9401905 , .9999999 /)
      rsrpiza(13, :) = (/ &
        .9148907 , .9956173 , .7504584 , .8131335 , .9401905 , .9999999 /)
      rsrpiza(14, :) = (/ &
        .5230504 , .7868518 , .8531531 , .4048149 , .8748231 , .2355667 /)

      rsrasya( 1, :) = (/ &
        0.700610 , 0.818871 , 0.702399 , 0.689886 , .4629866 , .1907639 /)
      rsrasya( 2, :) = (/ &
        0.700610 , 0.818871 , 0.702399 , 0.689886 , .4629866 , .1907639 /)
      rsrasya( 3, :) = (/ &
        0.636342 , 0.802467 , 0.691305 , 0.627497 , .6105750 , .4760794 /)
      rsrasya( 4, :) = (/ &
        0.636342 , 0.802467 , 0.691305 , 0.627497 , .6105750 , .4760794 /)
      rsrasya( 5, :) = (/ &
        0.636342 , 0.802467 , 0.691305 , 0.627497 , .6105750 , .4760794 /)
      rsrasya( 6, :) = (/ &
        0.636342 , 0.802467 , 0.691305 , 0.627497 , .6105750 , .4760794 /)
      rsrasya( 7, :) = (/ &
        0.636342 , 0.802467 , 0.691305 , 0.627497 , .6105750 , .4760794 /)
      rsrasya( 8, :) = (/ &
        0.668431 , 0.788530 , 0.698682 , 0.657422 , .6735182 , .6519706 /)
      rsrasya( 9, :) = (/ &
        0.668431 , 0.788530 , 0.698682 , 0.657422 , .6735182 , .6519706 /)
      rsrasya(10, :) = (/ &
        0.729019 , 0.803129 , 0.784592 , 0.712208 , .7008249 , .7270548 /)
      rsrasya(11, :) = (/ &
        0.729019 , 0.803129 , 0.784592 , 0.712208 , .7008249 , .7270548 /)
      rsrasya(12, :) = (/ &
        0.729019 , 0.803129 , 0.784592 , 0.712208 , .7008249 , .7270548 /)
      rsrasya(13, :) = (/ &
        0.729019 , 0.803129 , 0.784592 , 0.712208 , .7008249 , .7270548 /)
      rsrasya(14, :) = (/ &
        0.700610 , 0.818871 , 0.702399 , 0.689886 , .4629866 , .1907639 /)

      end subroutine swaerpr
 
!***************************************************************************
      subroutine cmbgb16s
!***************************************************************************
!
!  Original version:       MJIacono; July 1998
!  Revision for RRTM_SW:   MJIacono; November 2002
!  Revision for RRTMG_SW:  MJIacono; December 2003
!  Revision for F90 reformatting:  MJIacono; July 2006
!
!  The subroutines CMBGB16->CMBGB29 input the absorption coefficient
!  data for each band, which are defined for 16 g-points and 14 spectral
!  bands. The data are combined with appropriate weighting following the
!  g-point mapping arrays specified in RRTMG_SW_INIT.  Solar source 
!  function data in array SFLUXREF are combined without weighting.  All
!  g-point reduced data are put into new arrays for use in RRTMG_SW.
!
!  band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
!
!-----------------------------------------------------------------------

      use rrsw_kg16_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref

! ------- 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(1)
                  sumk = 0.
                  do ipr = 1, ngn(igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm)
                  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(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,3
         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

      iprsm = 0
      do igc = 1,ngc(1)
         sumf = 0.
         do ipr = 1, ngn(igc)
            iprsm = iprsm + 1
            sumf = sumf + sfluxrefo(iprsm)
         enddo
         sfluxref(igc) = sumf
      enddo

      end subroutine cmbgb16s

!***************************************************************************
      subroutine cmbgb17
!***************************************************************************
!
!     band 17:  3250-4000 cm-1 (low - h2o,co2; high - h2o,co2)
!-----------------------------------------------------------------------

      use rrsw_kg17_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref

! ------- 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(2)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(1)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+16)
                  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(2)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(1)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+16)
                  enddo
                  kb(jn,jt,jp,igc) = sumk
               enddo
            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

      do jp = 1,5
         iprsm = 0
         do igc = 1,ngc(2)
            sumf = 0.
            do ipr = 1, ngn(ngs(1)+igc)
               iprsm = iprsm + 1
               sumf = sumf + sfluxrefo(iprsm,jp)
            enddo
            sfluxref(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb17

!***************************************************************************
      subroutine cmbgb18
!***************************************************************************
!
!     band 18:  4000-4650 cm-1 (low - h2o,ch4; high - ch4)
!-----------------------------------------------------------------------

      use rrsw_kg18_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref

! ------- 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 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(jt,jp,iprsm)*rwgt(iprsm+32)
               enddo
               kb(jt,jp,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,3
         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 + sfluxrefo(iprsm,jp)
            enddo
            sfluxref(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb18

!***************************************************************************
      subroutine cmbgb19
!***************************************************************************
!
!     band 19:  4650-5150 cm-1 (low - h2o,co2; high - co2)
!-----------------------------------------------------------------------

      use rrsw_kg19_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref

! ------- 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 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(jt,jp,iprsm)*rwgt(iprsm+48)
               enddo
               kb(jt,jp,igc) = sumk
            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,3
         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 + sfluxrefo(iprsm,jp)
            enddo
            sfluxref(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb19

!***************************************************************************
      subroutine cmbgb20
!***************************************************************************
!
!     band 20:  5150-6150 cm-1 (low - h2o; high - h2o)
!-----------------------------------------------------------------------

      use rrsw_kg20_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, absch4o, &
                            absa, ka, absb, kb, selfref, forref, sfluxref, absch4

! ------- 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(5)
               sumk = 0.
               do ipr = 1, ngn(ngs(4)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+64)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
         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(jt,jp,iprsm)*rwgt(iprsm+64)
               enddo
               kb(jt,jp,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

      iprsm = 0
      do igc = 1,ngc(5)
         sumf1 = 0.
         sumf2 = 0.
         do ipr = 1, ngn(ngs(4)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + sfluxrefo(iprsm)
            sumf2 = sumf2 + absch4o(iprsm)*rwgt(iprsm+64)
         enddo
         sfluxref(igc) = sumf1
         absch4(igc) = sumf2
      enddo

      end subroutine cmbgb20

!***************************************************************************
      subroutine cmbgb21
!***************************************************************************
!
!     band 21:  6150-7700 cm-1 (low - h2o,co2; high - h2o,co2)
!-----------------------------------------------------------------------

      use rrsw_kg21_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref

! ------- 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(6)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(5)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+80)
                  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(6)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(5)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+80)
                  enddo
                  kb(jn,jt,jp,igc) = sumk
               enddo
            enddo
         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

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(6)
            sumf = 0.
            do ipr = 1, ngn(ngs(5)+igc)
               iprsm = iprsm + 1
               sumf = sumf + sfluxrefo(iprsm,jp)
            enddo
            sfluxref(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb21

!***************************************************************************
      subroutine cmbgb22
!***************************************************************************
!
!     band 22:  7700-8050 cm-1 (low - h2o,o2; high - o2)
!-----------------------------------------------------------------------

      use rrsw_kg22_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref

! ------- 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 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,3
         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 + sfluxrefo(iprsm,jp)
            enddo
            sfluxref(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb22

!***************************************************************************
      subroutine cmbgb23
!***************************************************************************
!
!     band 23:  8050-12850 cm-1 (low - h2o; high - nothing)
!-----------------------------------------------------------------------

      use rrsw_kg23_f, only : kao, selfrefo, forrefo, sfluxrefo, raylo, &
                            absa, ka, selfref, forref, sfluxref, rayl

! ------- 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(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,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,3
         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

      iprsm = 0
      do igc = 1,ngc(8)
         sumf1 = 0.
         sumf2 = 0.
         do ipr = 1, ngn(ngs(7)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + sfluxrefo(iprsm)
            sumf2 = sumf2 + raylo(iprsm)*rwgt(iprsm+112)
         enddo
         sfluxref(igc) = sumf1
         rayl(igc) = sumf2
      enddo

      end subroutine cmbgb23

!***************************************************************************
      subroutine cmbgb24
!***************************************************************************
!
!     band 24:  12850-16000 cm-1 (low - h2o,o2; high - o2)
!-----------------------------------------------------------------------

      use rrsw_kg24_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            abso3ao, abso3bo, raylao, raylbo, &
                            absa, ka, absb, kb, selfref, forref, sfluxref, &
                            abso3a, abso3b, rayla, raylb

! ------- Local -------
      integer  :: jn, jt, jp, igc, ipr, iprsm
      real  :: sumk, sumf1, sumf2, sumf3


      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 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,3
         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

      iprsm = 0
      do igc = 1,ngc(9)
         sumf1 = 0.
         sumf2 = 0.
         sumf3 = 0.
         do ipr = 1, ngn(ngs(8)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + raylbo(iprsm)*rwgt(iprsm+128)
            sumf2 = sumf2 + abso3ao(iprsm)*rwgt(iprsm+128)
            sumf3 = sumf3 + abso3bo(iprsm)*rwgt(iprsm+128)
         enddo
         raylb(igc) = sumf1
         abso3a(igc) = sumf2
         abso3b(igc) = sumf3
      enddo

      do jp = 1,9
         iprsm = 0
         do igc = 1,ngc(9)
            sumf1 = 0.
            sumf2 = 0.
            do ipr = 1, ngn(ngs(8)+igc)
               iprsm = iprsm + 1
               sumf1 = sumf1 + sfluxrefo(iprsm,jp)
               sumf2 = sumf2 + raylao(iprsm,jp)*rwgt(iprsm+128)
            enddo
            sfluxref(igc,jp) = sumf1
            rayla(igc,jp) = sumf2
         enddo
      enddo

      end subroutine cmbgb24

!***************************************************************************
      subroutine cmbgb25
!***************************************************************************
!
!     band 25:  16000-22650 cm-1 (low - h2o; high - nothing)
!-----------------------------------------------------------------------

      use rrsw_kg25_f, only : kao, sfluxrefo, &
                            abso3ao, abso3bo, raylo, &
                            absa, ka, sfluxref, &
                            abso3a, abso3b, rayl

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm
      real  :: sumk, sumf1, sumf2, sumf3, sumf4


      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

      iprsm = 0
      do igc = 1,ngc(10)
         sumf1 = 0.
         sumf2 = 0.
         sumf3 = 0.
         sumf4 = 0.
         do ipr = 1, ngn(ngs(9)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + sfluxrefo(iprsm)
            sumf2 = sumf2 + abso3ao(iprsm)*rwgt(iprsm+144)
            sumf3 = sumf3 + abso3bo(iprsm)*rwgt(iprsm+144)
            sumf4 = sumf4 + raylo(iprsm)*rwgt(iprsm+144)
         enddo
         sfluxref(igc) = sumf1
         abso3a(igc) = sumf2
         abso3b(igc) = sumf3
         rayl(igc) = sumf4
      enddo

      end subroutine cmbgb25

!***************************************************************************
      subroutine cmbgb26
!***************************************************************************
!
!     band 26:  22650-29000 cm-1 (low - nothing; high - nothing)
!-----------------------------------------------------------------------

      use rrsw_kg26_f, only : sfluxrefo, raylo, &
                            sfluxref, rayl

! ------- Local -------
      integer  :: igc, ipr, iprsm
      real  :: sumf1, sumf2


      iprsm = 0
      do igc = 1,ngc(11)
         sumf1 = 0.
         sumf2 = 0.
         do ipr = 1, ngn(ngs(10)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + raylo(iprsm)*rwgt(iprsm+160)
            sumf2 = sumf2 + sfluxrefo(iprsm)
         enddo
         rayl(igc) = sumf1
         sfluxref(igc) = sumf2
      enddo

      end subroutine cmbgb26

!***************************************************************************
      subroutine cmbgb27
!***************************************************************************
!
!     band 27:  29000-38000 cm-1 (low - o3; high - o3)
!-----------------------------------------------------------------------

      use rrsw_kg27_f, only : kao, kbo, sfluxrefo, raylo, &
                            absa, ka, absb, kb, sfluxref, rayl

! ------- 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(12)
               sumk = 0.
               do ipr = 1, ngn(ngs(11)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+176)
               enddo
               ka(jt,jp,igc) = sumk
            enddo
         enddo
         do jp = 13,59
            iprsm = 0
            do igc = 1,ngc(12)
               sumk = 0.
               do ipr = 1, ngn(ngs(11)+igc)
                  iprsm = iprsm + 1
                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+176)
               enddo
               kb(jt,jp,igc) = sumk
            enddo
         enddo
      enddo

      iprsm = 0
      do igc = 1,ngc(12)
         sumf1 = 0.
         sumf2 = 0.
         do ipr = 1, ngn(ngs(11)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + sfluxrefo(iprsm)
            sumf2 = sumf2 + raylo(iprsm)*rwgt(iprsm+176)
         enddo
         sfluxref(igc) = sumf1
         rayl(igc) = sumf2
      enddo

      end subroutine cmbgb27

!***************************************************************************
      subroutine cmbgb28
!***************************************************************************
!
!     band 28:  38000-50000 cm-1 (low - o3,o2; high - o3,o2)
!-----------------------------------------------------------------------

      use rrsw_kg28_f, only : kao, kbo, sfluxrefo, &
                            absa, ka, absb, kb, sfluxref

! ------- 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(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,5
         do jt = 1,5
            do jp = 13,59
               iprsm = 0
               do igc = 1,ngc(13)
                  sumk = 0.
                  do ipr = 1, ngn(ngs(12)+igc)
                     iprsm = iprsm + 1
                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+192)
                  enddo
                  kb(jn,jt,jp,igc) = sumk
               enddo
            enddo
         enddo
      enddo

      do jp = 1,5
         iprsm = 0
         do igc = 1,ngc(13)
            sumf = 0.
            do ipr = 1, ngn(ngs(12)+igc)
               iprsm = iprsm + 1
               sumf = sumf + sfluxrefo(iprsm,jp)
            enddo
            sfluxref(igc,jp) = sumf
         enddo
      enddo

      end subroutine cmbgb28

!***************************************************************************
      subroutine cmbgb29
!***************************************************************************
!
!     band 29:  820-2600 cm-1 (low - h2o; high - co2)
!-----------------------------------------------------------------------

      use rrsw_kg29_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absh2oo, absco2o, &
                            absa, ka, absb, kb, selfref, forref, sfluxref, &
                            absh2o, absco2

! ------- Local -------
      integer  :: jt, jp, igc, ipr, iprsm
      real  :: sumk, sumf1, sumf2, sumf3


      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
         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.
         sumf3 = 0.
         do ipr = 1, ngn(ngs(13)+igc)
            iprsm = iprsm + 1
            sumf1 = sumf1 + sfluxrefo(iprsm)
            sumf2 = sumf2 + absco2o(iprsm)*rwgt(iprsm+208)
            sumf3 = sumf3 + absh2oo(iprsm)*rwgt(iprsm+208)
         enddo
         sfluxref(igc) = sumf1
         absco2(igc) = sumf2
         absh2o(igc) = sumf3
      enddo

      end subroutine cmbgb29

!***********************************************************************
      subroutine swcldpr
!***********************************************************************

! Purpose: Define cloud extinction coefficient, single scattering albedo
!          and asymmetry parameter data.
!

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

      use rrsw_cld_f, only : extliq1, ssaliq1, asyliq1, &
                           extice2, ssaice2, asyice2, &
                           extice3, ssaice3, asyice3, fdlice3, &
                           abari, bbari, cbari, dbari, ebari, fbari

      save

!-----------------------------------------------------------------------
!
! Explanation of the method for each value of INFLAG.  A value of
!  0 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, the cloud optical
!    depth, the cloud single-scattering albedo, and the
!    moments of the phase function (0:NSTREAM).  Note
!    that these values are delta-m scaled within this
!    subroutine.

!  INFLAG = 2:  For each cloudy layer, the cloud fraction, cloud 
!    water path (g/m2), and cloud ice fraction are input.
!  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.
!    This version uses Ebert and Curry, JGR, (1992) method for 
!    ice particles larger than 131.0 microns. 
!  ICEFLAG = 3:  The ice generalized effective size (dge) is input
!    and the optical depths, single-scattering albedo,
!    and phase function moments are calculated as in
!    Q. Fu, J. Climate, (1996). Q. Fu provided high resolution
!    tables which were appropriately averaged for the
!    bands in RRTM_SW.  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. 
!    This version uses Ebert and Curry, JGR, (1992) method for 
!    ice particles larger than 140.0 microns. 
!  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) with
!    modified coefficients derived from Mie scattering calculations. 
!    The values for absorption coefficients appropriate for
!    the spectral bands in RRTM/RRTMG 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.
!    ..Updated tables suggested by Peter Blossey (Univ. Washington) 
!    and came from RRTMG_SW_v3.9 from AER, Inc.
!
!     ------------------------------------------------------------------

! Everything below is for INFLAG = 2.

! Coefficients for Ebert and Curry method
      abari(:) = (/ &
        & 3.448e-03 ,3.448e-03 ,3.448e-03 ,3.448e-03 ,3.448e-03  /)
      bbari(:) = (/ &
        & 2.431e+00 ,2.431e+00 ,2.431e+00 ,2.431e+00 ,2.431e+00  /)
      cbari(:) = (/ &
        & 1.000e-05 ,1.100e-04 ,1.240e-02 ,3.779e-02 ,4.666e-01  /)
      dbari(:) = (/ &
        & 0.000e+00 ,1.405e-05 ,6.867e-04 ,1.284e-03 ,2.050e-05  /)
      ebari(:) = (/ &
        & 7.661e-01 ,7.730e-01 ,7.865e-01 ,8.172e-01 ,9.595e-01  /)
      fbari(:) = (/ &
        & 5.851e-04 ,5.665e-04 ,7.204e-04 ,7.463e-04 ,1.076e-04  /)

! LIQFLAG==1 extinction coefficients, single scattering albedos, and asymmetry parameters
!   Derived from on Mie scattering computations; based on Hu & Stamnes coefficients

! Extinction coefficient
!     BAND  16
      extliq1(:, 16) = (/ &
        & 9.004493E-01,6.366723E-01,4.542354E-01,3.468253E-01,2.816431E-01,&
        & 2.383415E-01,2.070854E-01,1.831854E-01,1.642115E-01,1.487539E-01,&
        & 1.359169E-01,1.250900E-01,1.158354E-01,1.078400E-01,1.008646E-01,&
        & 9.472307E-02,8.928000E-02,8.442308E-02,8.005924E-02,7.612231E-02,&
        & 7.255153E-02,6.929539E-02,6.631769E-02,6.358153E-02,6.106231E-02,&
        & 5.873077E-02,5.656924E-02,5.455769E-02,5.267846E-02,5.091923E-02,&
        & 4.926692E-02,4.771154E-02,4.623923E-02,4.484385E-02,4.351539E-02,&
        & 4.224615E-02,4.103385E-02,3.986538E-02,3.874077E-02,3.765462E-02,&
        & 3.660077E-02,3.557384E-02,3.457615E-02,3.360308E-02,3.265000E-02,&
        & 3.171770E-02,3.080538E-02,2.990846E-02,2.903000E-02,2.816461E-02,&
        & 2.731539E-02,2.648231E-02,2.566308E-02,2.485923E-02,2.407000E-02,&
        & 2.329615E-02,2.253769E-02,2.179615E-02 /)
!     BAND  17
      extliq1(:, 17) = (/ &
       & 6.741200e-01,5.390739e-01,4.198767e-01,3.332553e-01,2.735633e-01,&
       & 2.317727e-01,2.012760e-01,1.780400e-01,1.596927e-01,1.447980e-01,&
       & 1.324480e-01,1.220347e-01,1.131327e-01,1.054313e-01,9.870534e-02,&
       & 9.278200e-02,8.752599e-02,8.282933e-02,7.860600e-02,7.479133e-02,&
       & 7.132800e-02,6.816733e-02,6.527401e-02,6.261266e-02,6.015934e-02,&
       & 5.788867e-02,5.578134e-02,5.381667e-02,5.198133e-02,5.026067e-02,&
       & 4.864466e-02,4.712267e-02,4.568066e-02,4.431200e-02,4.300867e-02,&
       & 4.176600e-02,4.057400e-02,3.942534e-02,3.832066e-02,3.725068e-02,&
       & 3.621400e-02,3.520533e-02,3.422333e-02,3.326400e-02,3.232467e-02,&
       & 3.140535e-02,3.050400e-02,2.962000e-02,2.875267e-02,2.789800e-02,&
       & 2.705934e-02,2.623667e-02,2.542667e-02,2.463200e-02,2.385267e-02,&
       & 2.308667e-02,2.233667e-02,2.160067e-02 /)
!     BAND  18
      extliq1(:, 18) = (/ &
       & 9.250861e-01,6.245692e-01,4.347038e-01,3.320208e-01,2.714869e-01,&
       & 2.309516e-01,2.012592e-01,1.783315e-01,1.600369e-01,1.451000e-01,&
       & 1.326838e-01,1.222069e-01,1.132554e-01,1.055146e-01,9.876000e-02,&
       & 9.281386e-02,8.754000e-02,8.283078e-02,7.860077e-02,7.477769e-02,&
       & 7.130847e-02,6.814461e-02,6.524615e-02,6.258462e-02,6.012847e-02,&
       & 5.785462e-02,5.574231e-02,5.378000e-02,5.194461e-02,5.022462e-02,&
       & 4.860846e-02,4.708462e-02,4.564154e-02,4.427462e-02,4.297231e-02,&
       & 4.172769e-02,4.053693e-02,3.939000e-02,3.828462e-02,3.721692e-02,&
       & 3.618000e-02,3.517077e-02,3.418923e-02,3.323077e-02,3.229154e-02,&
       & 3.137154e-02,3.047154e-02,2.959077e-02,2.872308e-02,2.786846e-02,&
       & 2.703077e-02,2.620923e-02,2.540077e-02,2.460615e-02,2.382693e-02,&
       & 2.306231e-02,2.231231e-02,2.157923e-02 /)
!     BAND  19
      extliq1(:, 19) = (/ &
       & 9.298960e-01,5.776460e-01,4.083450e-01,3.211160e-01,2.666390e-01,&
       & 2.281990e-01,1.993250e-01,1.768080e-01,1.587810e-01,1.440390e-01,&
       & 1.317720e-01,1.214150e-01,1.125540e-01,1.048890e-01,9.819600e-02,&
       & 9.230201e-02,8.706900e-02,8.239698e-02,7.819500e-02,7.439899e-02,&
       & 7.095300e-02,6.780700e-02,6.492900e-02,6.228600e-02,5.984600e-02,&
       & 5.758599e-02,5.549099e-02,5.353801e-02,5.171400e-02,5.000500e-02,&
       & 4.840000e-02,4.688500e-02,4.545100e-02,4.409300e-02,4.279700e-02,&
       & 4.156100e-02,4.037700e-02,3.923800e-02,3.813800e-02,3.707600e-02,&
       & 3.604500e-02,3.504300e-02,3.406500e-02,3.310800e-02,3.217700e-02,&
       & 3.126600e-02,3.036800e-02,2.948900e-02,2.862400e-02,2.777500e-02,&
       & 2.694200e-02,2.612300e-02,2.531700e-02,2.452800e-02,2.375100e-02,&
       & 2.299100e-02,2.224300e-02,2.151201e-02 /)
!     BAND  20
      extliq1(:, 20) = (/ &
       & 8.780964e-01,5.407031e-01,3.961100e-01,3.166645e-01,2.640455e-01,&
       & 2.261070e-01,1.974820e-01,1.751775e-01,1.573415e-01,1.427725e-01,&
       & 1.306535e-01,1.204195e-01,1.116650e-01,1.040915e-01,9.747550e-02,&
       & 9.164800e-02,8.647649e-02,8.185501e-02,7.770200e-02,7.394749e-02,&
       & 7.053800e-02,6.742700e-02,6.457999e-02,6.196149e-02,5.954450e-02,&
       & 5.730650e-02,5.522949e-02,5.329450e-02,5.148500e-02,4.979000e-02,&
       & 4.819600e-02,4.669301e-02,4.527050e-02,4.391899e-02,4.263500e-02,&
       & 4.140500e-02,4.022850e-02,3.909500e-02,3.800199e-02,3.694600e-02,&
       & 3.592000e-02,3.492250e-02,3.395050e-02,3.300150e-02,3.207250e-02,&
       & 3.116250e-02,3.027100e-02,2.939500e-02,2.853500e-02,2.768900e-02,&
       & 2.686000e-02,2.604350e-02,2.524150e-02,2.445350e-02,2.368049e-02,&
       & 2.292150e-02,2.217800e-02,2.144800e-02 /)
!     BAND  21
      extliq1(:, 21) = (/ &
       & 7.937480e-01,5.123036e-01,3.858181e-01,3.099622e-01,2.586829e-01,&
       & 2.217587e-01,1.939755e-01,1.723397e-01,1.550258e-01,1.408600e-01,&
       & 1.290545e-01,1.190661e-01,1.105039e-01,1.030848e-01,9.659387e-02,&
       & 9.086775e-02,8.577807e-02,8.122452e-02,7.712711e-02,7.342193e-02,&
       & 7.005387e-02,6.697840e-02,6.416000e-02,6.156903e-02,5.917484e-02,&
       & 5.695807e-02,5.489968e-02,5.298097e-02,5.118806e-02,4.950645e-02,&
       & 4.792710e-02,4.643581e-02,4.502484e-02,4.368547e-02,4.241001e-02,&
       & 4.118936e-02,4.002193e-02,3.889711e-02,3.781322e-02,3.676387e-02,&
       & 3.574549e-02,3.475548e-02,3.379033e-02,3.284678e-02,3.192420e-02,&
       & 3.102032e-02,3.013484e-02,2.926258e-02,2.840839e-02,2.756742e-02,&
       & 2.674258e-02,2.593064e-02,2.513258e-02,2.435000e-02,2.358064e-02,&
       & 2.282581e-02,2.208548e-02,2.135936e-02 /)
!     BAND  22
      extliq1(:, 22) = (/ &
       & 7.533129e-01,5.033129e-01,3.811271e-01,3.062757e-01,2.558729e-01,&
       & 2.196828e-01,1.924372e-01,1.711714e-01,1.541086e-01,1.401114e-01,&
       & 1.284257e-01,1.185200e-01,1.100243e-01,1.026529e-01,9.620142e-02,&
       & 9.050714e-02,8.544428e-02,8.091714e-02,7.684000e-02,7.315429e-02,&
       & 6.980143e-02,6.673999e-02,6.394000e-02,6.136000e-02,5.897715e-02,&
       & 5.677000e-02,5.472285e-02,5.281286e-02,5.102858e-02,4.935429e-02,&
       & 4.778000e-02,4.629714e-02,4.489142e-02,4.355857e-02,4.228715e-02,&
       & 4.107285e-02,3.990857e-02,3.879000e-02,3.770999e-02,3.666429e-02,&
       & 3.565000e-02,3.466286e-02,3.370143e-02,3.276143e-02,3.184143e-02,&
       & 3.094000e-02,3.005714e-02,2.919000e-02,2.833714e-02,2.750000e-02,&
       & 2.667714e-02,2.586714e-02,2.507143e-02,2.429143e-02,2.352428e-02,&
       & 2.277143e-02,2.203429e-02,2.130857e-02 /)
!     BAND  23
      extliq1(:, 23) = (/ &
       & 7.079894e-01,4.878198e-01,3.719852e-01,3.001873e-01,2.514795e-01,&
       & 2.163013e-01,1.897100e-01,1.689033e-01,1.521793e-01,1.384449e-01,&
       & 1.269666e-01,1.172326e-01,1.088745e-01,1.016224e-01,9.527085e-02,&
       & 8.966240e-02,8.467543e-02,8.021144e-02,7.619344e-02,7.255676e-02,&
       & 6.924996e-02,6.623030e-02,6.346261e-02,6.091499e-02,5.856325e-02,&
       & 5.638385e-02,5.435930e-02,5.247156e-02,5.070699e-02,4.905230e-02,&
       & 4.749499e-02,4.602611e-02,4.463581e-02,4.331543e-02,4.205647e-02,&
       & 4.085241e-02,3.969978e-02,3.859033e-02,3.751877e-02,3.648168e-02,&
       & 3.547468e-02,3.449553e-02,3.354072e-02,3.260732e-02,3.169438e-02,&
       & 3.079969e-02,2.992146e-02,2.905875e-02,2.821201e-02,2.737873e-02,&
       & 2.656052e-02,2.575586e-02,2.496511e-02,2.418783e-02,2.342500e-02,&
       & 2.267646e-02,2.194177e-02,2.122146e-02 /)
!     BAND  24
      extliq1(:, 24) = (/ &
       & 6.850164e-01,4.762468e-01,3.642001e-01,2.946012e-01,2.472001e-01,&
       & 2.128588e-01,1.868537e-01,1.664893e-01,1.501142e-01,1.366620e-01,&
       & 1.254147e-01,1.158721e-01,1.076732e-01,1.005530e-01,9.431306e-02,&
       & 8.879891e-02,8.389232e-02,7.949714e-02,7.553857e-02,7.195474e-02,&
       & 6.869413e-02,6.571444e-02,6.298286e-02,6.046779e-02,5.814474e-02,&
       & 5.599141e-02,5.399114e-02,5.212443e-02,5.037870e-02,4.874321e-02,&
       & 4.720219e-02,4.574813e-02,4.437160e-02,4.306460e-02,4.181810e-02,&
       & 4.062603e-02,3.948252e-02,3.838256e-02,3.732049e-02,3.629192e-02,&
       & 3.529301e-02,3.432190e-02,3.337412e-02,3.244842e-02,3.154175e-02,&
       & 3.065253e-02,2.978063e-02,2.892367e-02,2.808221e-02,2.725478e-02,&
       & 2.644174e-02,2.564175e-02,2.485508e-02,2.408303e-02,2.332365e-02,&
       & 2.257890e-02,2.184824e-02,2.113224e-02 /)
!     BAND  25
      extliq1(:, 25) = (/ &
       & 6.673017e-01,4.664520e-01,3.579398e-01,2.902234e-01,2.439904e-01,&
       & 2.104149e-01,1.849277e-01,1.649234e-01,1.488087e-01,1.355515e-01,&
       & 1.244562e-01,1.150329e-01,1.069321e-01,9.989310e-02,9.372070e-02,&
       & 8.826450e-02,8.340622e-02,7.905378e-02,7.513109e-02,7.157859e-02,&
       & 6.834588e-02,6.539114e-02,6.268150e-02,6.018621e-02,5.788098e-02,&
       & 5.574351e-02,5.375699e-02,5.190412e-02,5.017099e-02,4.854497e-02,&
       & 4.701490e-02,4.557030e-02,4.420249e-02,4.290304e-02,4.166427e-02,&
       & 4.047820e-02,3.934232e-02,3.824778e-02,3.719236e-02,3.616931e-02,&
       & 3.517597e-02,3.420856e-02,3.326566e-02,3.234346e-02,3.144122e-02,&
       & 3.055684e-02,2.968798e-02,2.883519e-02,2.799635e-02,2.717228e-02,&
       & 2.636182e-02,2.556424e-02,2.478114e-02,2.401086e-02,2.325657e-02,&
       & 2.251506e-02,2.178594e-02,2.107301e-02 /)
!     BAND  26
      extliq1(:, 26) = (/ &
       & 6.552414e-01,4.599454e-01,3.538626e-01,2.873547e-01,2.418033e-01,&
       & 2.086660e-01,1.834885e-01,1.637142e-01,1.477767e-01,1.346583e-01,&
       & 1.236734e-01,1.143412e-01,1.063148e-01,9.933905e-02,9.322026e-02,&
       & 8.780979e-02,8.299230e-02,7.867554e-02,7.478450e-02,7.126053e-02,&
       & 6.805276e-02,6.512143e-02,6.243211e-02,5.995541e-02,5.766712e-02,&
       & 5.554484e-02,5.357246e-02,5.173222e-02,5.001069e-02,4.839505e-02,&
       & 4.687471e-02,4.543861e-02,4.407857e-02,4.278577e-02,4.155331e-02,&
       & 4.037322e-02,3.924302e-02,3.815376e-02,3.710172e-02,3.608296e-02,&
       & 3.509330e-02,3.412980e-02,3.319009e-02,3.227106e-02,3.137157e-02,&
       & 3.048950e-02,2.962365e-02,2.877297e-02,2.793726e-02,2.711500e-02,&
       & 2.630666e-02,2.551206e-02,2.473052e-02,2.396287e-02,2.320861e-02,&
       & 2.246810e-02,2.174162e-02,2.102927e-02 /)
!     BAND  27
      extliq1(:, 27) = (/ &
       & 6.430901e-01,4.532134e-01,3.496132e-01,2.844655e-01,2.397347e-01,&
       & 2.071236e-01,1.822976e-01,1.627640e-01,1.469961e-01,1.340006e-01,&
       & 1.231069e-01,1.138441e-01,1.058706e-01,9.893678e-02,9.285166e-02,&
       & 8.746871e-02,8.267411e-02,7.837656e-02,7.450257e-02,7.099318e-02,&
       & 6.779929e-02,6.487987e-02,6.220168e-02,5.973530e-02,5.745636e-02,&
       & 5.534344e-02,5.337986e-02,5.154797e-02,4.983404e-02,4.822582e-02,&
       & 4.671228e-02,4.528321e-02,4.392997e-02,4.264325e-02,4.141647e-02,&
       & 4.024259e-02,3.911767e-02,3.803309e-02,3.698782e-02,3.597140e-02,&
       & 3.498774e-02,3.402852e-02,3.309340e-02,3.217818e-02,3.128292e-02,&
       & 3.040486e-02,2.954230e-02,2.869545e-02,2.786261e-02,2.704372e-02,&
       & 2.623813e-02,2.544668e-02,2.466788e-02,2.390313e-02,2.315136e-02,&
       & 2.241391e-02,2.168921e-02,2.097903e-02 /)
!     BAND  28
      extliq1(:, 28) = (/ &
       & 6.367074e-01,4.495768e-01,3.471263e-01,2.826149e-01,2.382868e-01,&
       & 2.059640e-01,1.813562e-01,1.619881e-01,1.463436e-01,1.334402e-01,&
       & 1.226166e-01,1.134096e-01,1.054829e-01,9.858838e-02,9.253790e-02,&
       & 8.718582e-02,8.241830e-02,7.814482e-02,7.429212e-02,7.080165e-02,&
       & 6.762385e-02,6.471838e-02,6.205388e-02,5.959726e-02,5.732871e-02,&
       & 5.522402e-02,5.326793e-02,5.144230e-02,4.973440e-02,4.813188e-02,&
       & 4.662283e-02,4.519798e-02,4.384833e-02,4.256541e-02,4.134253e-02,&
       & 4.017136e-02,3.904911e-02,3.796779e-02,3.692364e-02,3.591182e-02,&
       & 3.492930e-02,3.397230e-02,3.303920e-02,3.212572e-02,3.123278e-02,&
       & 3.035519e-02,2.949493e-02,2.864985e-02,2.781840e-02,2.700197e-02,&
       & 2.619682e-02,2.540674e-02,2.462966e-02,2.386613e-02,2.311602e-02,&
       & 2.237846e-02,2.165660e-02,2.094756e-02 /)
!     BAND  29
      extliq1(:, 29) = (/ &
       & 4.298416e-01,4.391639e-01,3.975030e-01,3.443028e-01,2.957345e-01,&
       & 2.556461e-01,2.234755e-01,1.976636e-01,1.767428e-01,1.595611e-01,&
       & 1.452636e-01,1.332156e-01,1.229481e-01,1.141059e-01,1.064208e-01,&
       & 9.968527e-02,9.373833e-02,8.845221e-02,8.372112e-02,7.946667e-02,&
       & 7.561807e-02,7.212029e-02,6.893166e-02,6.600944e-02,6.332277e-02,&
       & 6.084277e-02,5.854721e-02,5.641361e-02,5.442639e-02,5.256750e-02,&
       & 5.082499e-02,4.918556e-02,4.763694e-02,4.617222e-02,4.477861e-02,&
       & 4.344861e-02,4.217999e-02,4.096111e-02,3.978638e-02,3.865361e-02,&
       & 3.755473e-02,3.649028e-02,3.545361e-02,3.444361e-02,3.345666e-02,&
       & 3.249167e-02,3.154722e-02,3.062083e-02,2.971250e-02,2.882083e-02,&
       & 2.794611e-02,2.708778e-02,2.624500e-02,2.541750e-02,2.460528e-02,&
       & 2.381194e-02,2.303250e-02,2.226833e-02 /)

! Single scattering albedo     
!     BAND  16
      ssaliq1(:, 16) = (/ &
       & 8.362119e-01,8.098460e-01,7.762291e-01,7.486042e-01,7.294172e-01,&
       & 7.161000e-01,7.060656e-01,6.978387e-01,6.907193e-01,6.843551e-01,&
       & 6.785668e-01,6.732450e-01,6.683191e-01,6.637264e-01,6.594307e-01,&
       & 6.554033e-01,6.516115e-01,6.480295e-01,6.446429e-01,6.414306e-01,&
       & 6.383783e-01,6.354750e-01,6.327068e-01,6.300665e-01,6.275376e-01,&
       & 6.251245e-01,6.228136e-01,6.205944e-01,6.184720e-01,6.164330e-01,&
       & 6.144742e-01,6.125962e-01,6.108004e-01,6.090740e-01,6.074200e-01,&
       & 6.058381e-01,6.043209e-01,6.028681e-01,6.014836e-01,6.001626e-01,&
       & 5.988957e-01,5.976864e-01,5.965390e-01,5.954379e-01,5.943972e-01,&
       & 5.934019e-01,5.924624e-01,5.915579e-01,5.907025e-01,5.898913e-01,&
       & 5.891213e-01,5.883815e-01,5.876851e-01,5.870158e-01,5.863868e-01,&
       & 5.857821e-01,5.852111e-01,5.846579e-01 /)
!     BAND  17
      ssaliq1(:, 17) = (/ &
       & 6.995459e-01,7.158012e-01,7.076001e-01,6.927244e-01,6.786434e-01,&
       & 6.673545e-01,6.585859e-01,6.516314e-01,6.459010e-01,6.410225e-01,&
       & 6.367574e-01,6.329554e-01,6.295119e-01,6.263595e-01,6.234462e-01,&
       & 6.207274e-01,6.181755e-01,6.157678e-01,6.134880e-01,6.113173e-01,&
       & 6.092495e-01,6.072689e-01,6.053717e-01,6.035507e-01,6.018001e-01,&
       & 6.001134e-01,5.984951e-01,5.969294e-01,5.954256e-01,5.939698e-01,&
       & 5.925716e-01,5.912265e-01,5.899270e-01,5.886771e-01,5.874746e-01,&
       & 5.863185e-01,5.852077e-01,5.841460e-01,5.831249e-01,5.821474e-01,&
       & 5.812078e-01,5.803173e-01,5.794616e-01,5.786443e-01,5.778617e-01,&
       & 5.771236e-01,5.764191e-01,5.757400e-01,5.750971e-01,5.744842e-01,&
       & 5.739012e-01,5.733482e-01,5.728175e-01,5.723214e-01,5.718383e-01,&
       & 5.713827e-01,5.709471e-01,5.705330e-01 /)
!     BAND  18
      ssaliq1(:, 18) = (/ &
       & 9.929711e-01,9.896942e-01,9.852408e-01,9.806820e-01,9.764512e-01,&
       & 9.725375e-01,9.688677e-01,9.653832e-01,9.620552e-01,9.588522e-01,&
       & 9.557475e-01,9.527265e-01,9.497731e-01,9.468756e-01,9.440270e-01,&
       & 9.412230e-01,9.384592e-01,9.357287e-01,9.330369e-01,9.303778e-01,&
       & 9.277502e-01,9.251546e-01,9.225907e-01,9.200553e-01,9.175521e-01,&
       & 9.150773e-01,9.126352e-01,9.102260e-01,9.078485e-01,9.055057e-01,&
       & 9.031978e-01,9.009306e-01,8.987010e-01,8.965177e-01,8.943774e-01,&
       & 8.922869e-01,8.902430e-01,8.882551e-01,8.863182e-01,8.844373e-01,&
       & 8.826143e-01,8.808499e-01,8.791413e-01,8.774940e-01,8.759019e-01,&
       & 8.743650e-01,8.728941e-01,8.714712e-01,8.701065e-01,8.688008e-01,&
       & 8.675409e-01,8.663295e-01,8.651714e-01,8.640637e-01,8.629943e-01,&
       & 8.619762e-01,8.609995e-01,8.600581e-01 /)
!     BAND  19
      ssaliq1(:, 19) = (/ &
       & 9.910612e-01,9.854226e-01,9.795008e-01,9.742920e-01,9.695996e-01,&
       & 9.652274e-01,9.610648e-01,9.570521e-01,9.531397e-01,9.493086e-01,&
       & 9.455413e-01,9.418362e-01,9.381902e-01,9.346016e-01,9.310718e-01,&
       & 9.275957e-01,9.241757e-01,9.208038e-01,9.174802e-01,9.142058e-01,&
       & 9.109753e-01,9.077895e-01,9.046433e-01,9.015409e-01,8.984784e-01,&
       & 8.954572e-01,8.924748e-01,8.895367e-01,8.866395e-01,8.837864e-01,&
       & 8.809819e-01,8.782267e-01,8.755231e-01,8.728712e-01,8.702802e-01,&
       & 8.677443e-01,8.652733e-01,8.628678e-01,8.605300e-01,8.582593e-01,&
       & 8.560596e-01,8.539352e-01,8.518782e-01,8.498915e-01,8.479790e-01,&
       & 8.461384e-01,8.443645e-01,8.426613e-01,8.410229e-01,8.394495e-01,&
       & 8.379428e-01,8.364967e-01,8.351117e-01,8.337820e-01,8.325091e-01,&
       & 8.312874e-01,8.301169e-01,8.289985e-01 /)
!     BAND  20
      ssaliq1(:, 20) = (/ &
       & 9.969802e-01,9.950445e-01,9.931448e-01,9.914272e-01,9.898652e-01,&
       & 9.884250e-01,9.870637e-01,9.857482e-01,9.844558e-01,9.831755e-01,&
       & 9.819068e-01,9.806477e-01,9.794000e-01,9.781666e-01,9.769461e-01,&
       & 9.757386e-01,9.745459e-01,9.733650e-01,9.721953e-01,9.710398e-01,&
       & 9.698936e-01,9.687583e-01,9.676334e-01,9.665192e-01,9.654132e-01,&
       & 9.643208e-01,9.632374e-01,9.621625e-01,9.611003e-01,9.600518e-01,&
       & 9.590144e-01,9.579922e-01,9.569864e-01,9.559948e-01,9.550239e-01,&
       & 9.540698e-01,9.531382e-01,9.522280e-01,9.513409e-01,9.504772e-01,&
       & 9.496360e-01,9.488220e-01,9.480327e-01,9.472693e-01,9.465333e-01,&
       & 9.458211e-01,9.451344e-01,9.444732e-01,9.438372e-01,9.432268e-01,&
       & 9.426391e-01,9.420757e-01,9.415308e-01,9.410102e-01,9.405115e-01,&
       & 9.400326e-01,9.395716e-01,9.391313e-01 /)
!     BAND  21
      ssaliq1(:, 21) = (/ &
       & 9.980034e-01,9.968572e-01,9.958696e-01,9.949747e-01,9.941241e-01,&
       & 9.933043e-01,9.924971e-01,9.916978e-01,9.909023e-01,9.901046e-01,&
       & 9.893087e-01,9.885146e-01,9.877195e-01,9.869283e-01,9.861379e-01,&
       & 9.853523e-01,9.845715e-01,9.837945e-01,9.830217e-01,9.822567e-01,&
       & 9.814935e-01,9.807356e-01,9.799815e-01,9.792332e-01,9.784845e-01,&
       & 9.777424e-01,9.770042e-01,9.762695e-01,9.755416e-01,9.748152e-01,&
       & 9.740974e-01,9.733873e-01,9.726813e-01,9.719861e-01,9.713010e-01,&
       & 9.706262e-01,9.699647e-01,9.693144e-01,9.686794e-01,9.680596e-01,&
       & 9.674540e-01,9.668657e-01,9.662926e-01,9.657390e-01,9.652019e-01,&
       & 9.646820e-01,9.641784e-01,9.636945e-01,9.632260e-01,9.627743e-01,&
       & 9.623418e-01,9.619227e-01,9.615194e-01,9.611341e-01,9.607629e-01,&
       & 9.604057e-01,9.600622e-01,9.597322e-01 /)
!     BAND  22
      ssaliq1(:, 22) = (/ &
       & 9.988219e-01,9.981767e-01,9.976168e-01,9.971066e-01,9.966195e-01,&
       & 9.961566e-01,9.956995e-01,9.952481e-01,9.947982e-01,9.943495e-01,&
       & 9.938955e-01,9.934368e-01,9.929825e-01,9.925239e-01,9.920653e-01,&
       & 9.916096e-01,9.911552e-01,9.907067e-01,9.902594e-01,9.898178e-01,&
       & 9.893791e-01,9.889453e-01,9.885122e-01,9.880837e-01,9.876567e-01,&
       & 9.872331e-01,9.868121e-01,9.863938e-01,9.859790e-01,9.855650e-01,&
       & 9.851548e-01,9.847491e-01,9.843496e-01,9.839521e-01,9.835606e-01,&
       & 9.831771e-01,9.827975e-01,9.824292e-01,9.820653e-01,9.817124e-01,&
       & 9.813644e-01,9.810291e-01,9.807020e-01,9.803864e-01,9.800782e-01,&
       & 9.797821e-01,9.794958e-01,9.792179e-01,9.789509e-01,9.786940e-01,&
       & 9.784460e-01,9.782090e-01,9.779789e-01,9.777553e-01,9.775425e-01,&
       & 9.773387e-01,9.771420e-01,9.769529e-01 /)
!     BAND  23
      ssaliq1(:, 23) = (/ &
       & 9.998902e-01,9.998395e-01,9.997915e-01,9.997442e-01,9.997016e-01,&
       & 9.996600e-01,9.996200e-01,9.995806e-01,9.995411e-01,9.995005e-01,&
       & 9.994589e-01,9.994178e-01,9.993766e-01,9.993359e-01,9.992948e-01,&
       & 9.992533e-01,9.992120e-01,9.991723e-01,9.991313e-01,9.990906e-01,&
       & 9.990510e-01,9.990113e-01,9.989716e-01,9.989323e-01,9.988923e-01,&
       & 9.988532e-01,9.988140e-01,9.987761e-01,9.987373e-01,9.986989e-01,&
       & 9.986597e-01,9.986239e-01,9.985861e-01,9.985485e-01,9.985123e-01,&
       & 9.984762e-01,9.984415e-01,9.984065e-01,9.983722e-01,9.983398e-01,&
       & 9.983078e-01,9.982758e-01,9.982461e-01,9.982157e-01,9.981872e-01,&
       & 9.981595e-01,9.981324e-01,9.981068e-01,9.980811e-01,9.980580e-01,&
       & 9.980344e-01,9.980111e-01,9.979908e-01,9.979690e-01,9.979492e-01,&
       & 9.979316e-01,9.979116e-01,9.978948e-01 /)
!     BAND  24
      ssaliq1(:, 24) = (/ &
       & 9.999978e-01,9.999948e-01,9.999915e-01,9.999905e-01,9.999896e-01,&
       & 9.999887e-01,9.999888e-01,9.999888e-01,9.999870e-01,9.999854e-01,&
       & 9.999855e-01,9.999856e-01,9.999839e-01,9.999834e-01,9.999829e-01,&
       & 9.999809e-01,9.999816e-01,9.999793e-01,9.999782e-01,9.999779e-01,&
       & 9.999772e-01,9.999764e-01,9.999756e-01,9.999744e-01,9.999744e-01,&
       & 9.999736e-01,9.999729e-01,9.999716e-01,9.999706e-01,9.999692e-01,&
       & 9.999690e-01,9.999675e-01,9.999673e-01,9.999660e-01,9.999654e-01,&
       & 9.999647e-01,9.999647e-01,9.999625e-01,9.999620e-01,9.999614e-01,&
       & 9.999613e-01,9.999607e-01,9.999604e-01,9.999594e-01,9.999589e-01,&
       & 9.999586e-01,9.999567e-01,9.999550e-01,9.999557e-01,9.999542e-01,&
       & 9.999546e-01,9.999539e-01,9.999536e-01,9.999526e-01,9.999523e-01,&
       & 9.999508e-01,9.999534e-01,9.999507e-01 /)
!     BAND  25
      ssaliq1(:, 25) = (/ &
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,&
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,&
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,&
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,9.999995e-01,&
       & 9.999995e-01,9.999990e-01,9.999991e-01,9.999991e-01,9.999990e-01,&
       & 9.999989e-01,9.999988e-01,9.999988e-01,9.999986e-01,9.999988e-01,&
       & 9.999986e-01,9.999987e-01,9.999986e-01,9.999985e-01,9.999985e-01,&
       & 9.999985e-01,9.999985e-01,9.999983e-01,9.999983e-01,9.999981e-01,&
       & 9.999981e-01,9.999986e-01,9.999985e-01,9.999983e-01,9.999984e-01,&
       & 9.999982e-01,9.999983e-01,9.999982e-01,9.999980e-01,9.999981e-01,&
       & 9.999978e-01,9.999979e-01,9.999985e-01,9.999985e-01,9.999983e-01,&
       & 9.999983e-01,9.999983e-01,9.999983e-01 /)
!     BAND  26
      ssaliq1(:, 26) = (/ &
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,&
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,&
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,&
       & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,9.999991e-01,&
       & 9.999990e-01,9.999992e-01,9.999995e-01,9.999986e-01,9.999994e-01,&
       & 9.999985e-01,9.999980e-01,9.999984e-01,9.999983e-01,9.999979e-01,&
       & 9.999969e-01,9.999977e-01,9.999971e-01,9.999969e-01,9.999969e-01,&
       & 9.999965e-01,9.999970e-01,9.999985e-01,9.999973e-01,9.999961e-01,&
       & 9.999968e-01,9.999952e-01,9.999970e-01,9.999974e-01,9.999965e-01,&
       & 9.999969e-01,9.999970e-01,9.999970e-01,9.999960e-01,9.999923e-01,&
       & 9.999958e-01,9.999937e-01,9.999960e-01,9.999953e-01,9.999946e-01,&
       & 9.999946e-01,9.999957e-01,9.999951e-01 /)
!     BAND  27
      ssaliq1(:, 27) = (/ &
       & 1.000000e+00,1.000000e+00,9.999983e-01,9.999979e-01,9.999965e-01,&
       & 9.999949e-01,9.999948e-01,9.999918e-01,9.999917e-01,9.999923e-01,&
       & 9.999908e-01,9.999889e-01,9.999902e-01,9.999895e-01,9.999881e-01,&
       & 9.999882e-01,9.999876e-01,9.999866e-01,9.999866e-01,9.999858e-01,&
       & 9.999860e-01,9.999852e-01,9.999836e-01,9.999831e-01,9.999818e-01,&
       & 9.999808e-01,9.999816e-01,9.999800e-01,9.999783e-01,9.999780e-01,&
       & 9.999763e-01,9.999746e-01,9.999731e-01,9.999713e-01,9.999762e-01,&
       & 9.999740e-01,9.999670e-01,9.999703e-01,9.999687e-01,9.999666e-01,&
       & 9.999683e-01,9.999667e-01,9.999611e-01,9.999635e-01,9.999600e-01,&
       & 9.999635e-01,9.999594e-01,9.999601e-01,9.999586e-01,9.999559e-01,&
       & 9.999569e-01,9.999558e-01,9.999523e-01,9.999535e-01,9.999529e-01,&
       & 9.999553e-01,9.999495e-01,9.999490e-01 /)
!     BAND  28
      ssaliq1(:, 28) = (/ &
       & 9.999920e-01,9.999873e-01,9.999855e-01,9.999832e-01,9.999807e-01,&
       & 9.999778e-01,9.999754e-01,9.999721e-01,9.999692e-01,9.999651e-01,&
       & 9.999621e-01,9.999607e-01,9.999567e-01,9.999546e-01,9.999521e-01,&
       & 9.999491e-01,9.999457e-01,9.999439e-01,9.999403e-01,9.999374e-01,&
       & 9.999353e-01,9.999315e-01,9.999282e-01,9.999244e-01,9.999234e-01,&
       & 9.999189e-01,9.999130e-01,9.999117e-01,9.999073e-01,9.999020e-01,&
       & 9.998993e-01,9.998987e-01,9.998922e-01,9.998893e-01,9.998869e-01,&
       & 9.998805e-01,9.998778e-01,9.998751e-01,9.998708e-01,9.998676e-01,&
       & 9.998624e-01,9.998642e-01,9.998582e-01,9.998547e-01,9.998546e-01,&
       & 9.998477e-01,9.998487e-01,9.998466e-01,9.998403e-01,9.998412e-01,&
       & 9.998406e-01,9.998342e-01,9.998326e-01,9.998333e-01,9.998328e-01,&
       & 9.998290e-01,9.998276e-01,9.998249e-01 /)
!     BAND  29
      ssaliq1(:, 29) = (/ &
       & 8.383753e-01,8.461471e-01,8.373325e-01,8.212889e-01,8.023834e-01,&
       & 7.829501e-01,7.641777e-01,7.466000e-01,7.304023e-01,7.155998e-01,&
       & 7.021259e-01,6.898840e-01,6.787615e-01,6.686479e-01,6.594414e-01,&
       & 6.510417e-01,6.433668e-01,6.363335e-01,6.298788e-01,6.239398e-01,&
       & 6.184633e-01,6.134055e-01,6.087228e-01,6.043786e-01,6.003439e-01,&
       & 5.965910e-01,5.930917e-01,5.898280e-01,5.867798e-01,5.839264e-01,&
       & 5.812576e-01,5.787592e-01,5.764163e-01,5.742189e-01,5.721598e-01,&
       & 5.702286e-01,5.684182e-01,5.667176e-01,5.651237e-01,5.636253e-01,&
       & 5.622228e-01,5.609074e-01,5.596713e-01,5.585089e-01,5.574223e-01,&
       & 5.564002e-01,5.554411e-01,5.545397e-01,5.536914e-01,5.528967e-01,&
       & 5.521495e-01,5.514457e-01,5.507818e-01,5.501623e-01,5.495750e-01,&
       & 5.490192e-01,5.484980e-01,5.480046e-01 /)

! Asymmetry parameter
!     BAND  16
      asyliq1(:, 16) = (/ &
       & 8.038165e-01,8.014154e-01,7.942381e-01,7.970521e-01,8.086621e-01,&
       & 8.233392e-01,8.374127e-01,8.495742e-01,8.596945e-01,8.680497e-01,&
       & 8.750005e-01,8.808589e-01,8.858749e-01,8.902403e-01,8.940939e-01,&
       & 8.975379e-01,9.006450e-01,9.034741e-01,9.060659e-01,9.084561e-01,&
       & 9.106675e-01,9.127198e-01,9.146332e-01,9.164194e-01,9.180970e-01,&
       & 9.196658e-01,9.211421e-01,9.225352e-01,9.238443e-01,9.250841e-01,&
       & 9.262541e-01,9.273620e-01,9.284081e-01,9.294002e-01,9.303395e-01,&
       & 9.312285e-01,9.320715e-01,9.328716e-01,9.336271e-01,9.343427e-01,&
       & 9.350219e-01,9.356647e-01,9.362728e-01,9.368495e-01,9.373956e-01,&
       & 9.379113e-01,9.383987e-01,9.388608e-01,9.392986e-01,9.397132e-01,&
       & 9.401063e-01,9.404776e-01,9.408299e-01,9.411641e-01,9.414800e-01,&
       & 9.417787e-01,9.420633e-01,9.423364e-01 /)
!     BAND  17
      asyliq1(:, 17) = (/ &
       & 8.941000e-01,9.054049e-01,9.049510e-01,9.027216e-01,9.021636e-01,&
       & 9.037878e-01,9.069852e-01,9.109817e-01,9.152013e-01,9.193040e-01,&
       & 9.231177e-01,9.265712e-01,9.296606e-01,9.324048e-01,9.348419e-01,&
       & 9.370131e-01,9.389529e-01,9.406954e-01,9.422727e-01,9.437088e-01,&
       & 9.450221e-01,9.462308e-01,9.473488e-01,9.483830e-01,9.493492e-01,&
       & 9.502541e-01,9.510999e-01,9.518971e-01,9.526455e-01,9.533554e-01,&
       & 9.540249e-01,9.546571e-01,9.552551e-01,9.558258e-01,9.563603e-01,&
       & 9.568713e-01,9.573569e-01,9.578141e-01,9.582485e-01,9.586604e-01,&
       & 9.590525e-01,9.594218e-01,9.597710e-01,9.601052e-01,9.604181e-01,&
       & 9.607159e-01,9.609979e-01,9.612655e-01,9.615184e-01,9.617564e-01,&
       & 9.619860e-01,9.622009e-01,9.624031e-01,9.625957e-01,9.627792e-01,&
       & 9.629530e-01,9.631171e-01,9.632746e-01 /)
!     BAND  18
      asyliq1(:, 18) = (/ &
       & 8.574638e-01,8.351383e-01,8.142977e-01,8.083068e-01,8.129284e-01,&
       & 8.215827e-01,8.307238e-01,8.389963e-01,8.460481e-01,8.519273e-01,&
       & 8.568153e-01,8.609116e-01,8.643892e-01,8.673941e-01,8.700248e-01,&
       & 8.723707e-01,8.744902e-01,8.764240e-01,8.782057e-01,8.798593e-01,&
       & 8.814063e-01,8.828573e-01,8.842261e-01,8.855196e-01,8.867497e-01,&
       & 8.879164e-01,8.890316e-01,8.900941e-01,8.911118e-01,8.920832e-01,&
       & 8.930156e-01,8.939091e-01,8.947663e-01,8.955888e-01,8.963786e-01,&
       & 8.971350e-01,8.978617e-01,8.985590e-01,8.992243e-01,8.998631e-01,&
       & 9.004753e-01,9.010602e-01,9.016192e-01,9.021542e-01,9.026644e-01,&
       & 9.031535e-01,9.036194e-01,9.040656e-01,9.044894e-01,9.048933e-01,&
       & 9.052789e-01,9.056481e-01,9.060004e-01,9.063343e-01,9.066544e-01,&
       & 9.069604e-01,9.072512e-01,9.075290e-01 /)
!     BAND  19
      asyliq1(:, 19) = (/ &
       & 8.349569e-01,8.034579e-01,7.932136e-01,8.010156e-01,8.137083e-01,&
       & 8.255339e-01,8.351938e-01,8.428286e-01,8.488944e-01,8.538187e-01,&
       & 8.579255e-01,8.614473e-01,8.645338e-01,8.672908e-01,8.697947e-01,&
       & 8.720843e-01,8.742015e-01,8.761718e-01,8.780160e-01,8.797479e-01,&
       & 8.813810e-01,8.829250e-01,8.843907e-01,8.857822e-01,8.871059e-01,&
       & 8.883724e-01,8.895810e-01,8.907384e-01,8.918456e-01,8.929083e-01,&
       & 8.939284e-01,8.949060e-01,8.958463e-01,8.967486e-01,8.976129e-01,&
       & 8.984463e-01,8.992439e-01,9.000094e-01,9.007438e-01,9.014496e-01,&
       & 9.021235e-01,9.027699e-01,9.033859e-01,9.039772e-01,9.045419e-01,&
       & 9.050819e-01,9.055975e-01,9.060907e-01,9.065607e-01,9.070093e-01,&
       & 9.074389e-01,9.078475e-01,9.082388e-01,9.086117e-01,9.089678e-01,&
       & 9.093081e-01,9.096307e-01,9.099410e-01 /)
!     BAND  20
      asyliq1(:, 20) = (/ &
       & 8.109692e-01,7.846657e-01,7.881928e-01,8.009509e-01,8.131208e-01,&
       & 8.230400e-01,8.309448e-01,8.372920e-01,8.424837e-01,8.468166e-01,&
       & 8.504947e-01,8.536642e-01,8.564256e-01,8.588513e-01,8.610011e-01,&
       & 8.629122e-01,8.646262e-01,8.661720e-01,8.675752e-01,8.688582e-01,&
       & 8.700379e-01,8.711300e-01,8.721485e-01,8.731027e-01,8.740010e-01,&
       & 8.748499e-01,8.756564e-01,8.764239e-01,8.771542e-01,8.778523e-01,&
       & 8.785211e-01,8.791601e-01,8.797725e-01,8.803589e-01,8.809173e-01,&
       & 8.814552e-01,8.819705e-01,8.824611e-01,8.829311e-01,8.833791e-01,&
       & 8.838078e-01,8.842148e-01,8.846044e-01,8.849756e-01,8.853291e-01,&
       & 8.856645e-01,8.859841e-01,8.862904e-01,8.865801e-01,8.868551e-01,&
       & 8.871182e-01,8.873673e-01,8.876059e-01,8.878307e-01,8.880462e-01,&
       & 8.882501e-01,8.884453e-01,8.886339e-01 /)
!     BAND  21
      asyliq1(:, 21) = (/ &
       & 7.838510e-01,7.803151e-01,7.980477e-01,8.144160e-01,8.261784e-01,&
       & 8.344240e-01,8.404278e-01,8.450391e-01,8.487593e-01,8.518741e-01,&
       & 8.545484e-01,8.568890e-01,8.589560e-01,8.607983e-01,8.624504e-01,&
       & 8.639408e-01,8.652945e-01,8.665301e-01,8.676634e-01,8.687121e-01,&
       & 8.696855e-01,8.705933e-01,8.714448e-01,8.722454e-01,8.730014e-01,&
       & 8.737180e-01,8.743982e-01,8.750436e-01,8.756598e-01,8.762481e-01,&
       & 8.768089e-01,8.773427e-01,8.778532e-01,8.783434e-01,8.788089e-01,&
       & 8.792530e-01,8.796784e-01,8.800845e-01,8.804716e-01,8.808411e-01,&
       & 8.811923e-01,8.815276e-01,8.818472e-01,8.821504e-01,8.824408e-01,&
       & 8.827155e-01,8.829777e-01,8.832269e-01,8.834631e-01,8.836892e-01,&
       & 8.839034e-01,8.841075e-01,8.843021e-01,8.844866e-01,8.846631e-01,&
       & 8.848304e-01,8.849910e-01,8.851425e-01 /)
!     BAND  22
      asyliq1(:, 22) = (/ &
       & 7.760783e-01,7.890215e-01,8.090192e-01,8.230252e-01,8.321369e-01,&
       & 8.384258e-01,8.431529e-01,8.469558e-01,8.501499e-01,8.528899e-01,&
       & 8.552899e-01,8.573956e-01,8.592570e-01,8.609098e-01,8.623897e-01,&
       & 8.637169e-01,8.649184e-01,8.660097e-01,8.670096e-01,8.679338e-01,&
       & 8.687896e-01,8.695880e-01,8.703365e-01,8.710422e-01,8.717092e-01,&
       & 8.723378e-01,8.729363e-01,8.735063e-01,8.740475e-01,8.745661e-01,&
       & 8.750560e-01,8.755275e-01,8.759731e-01,8.764000e-01,8.768071e-01,&
       & 8.771942e-01,8.775628e-01,8.779126e-01,8.782483e-01,8.785626e-01,&
       & 8.788610e-01,8.791482e-01,8.794180e-01,8.796765e-01,8.799207e-01,&
       & 8.801522e-01,8.803707e-01,8.805777e-01,8.807749e-01,8.809605e-01,&
       & 8.811362e-01,8.813047e-01,8.814647e-01,8.816131e-01,8.817588e-01,&
       & 8.818930e-01,8.820230e-01,8.821445e-01 /)
!     BAND  23
      asyliq1(:, 23) = (/ &
       & 7.847907e-01,8.099917e-01,8.257428e-01,8.350423e-01,8.411971e-01,&
       & 8.457241e-01,8.493010e-01,8.522565e-01,8.547660e-01,8.569311e-01,&
       & 8.588181e-01,8.604729e-01,8.619296e-01,8.632208e-01,8.643725e-01,&
       & 8.654050e-01,8.663363e-01,8.671835e-01,8.679590e-01,8.686707e-01,&
       & 8.693308e-01,8.699433e-01,8.705147e-01,8.710490e-01,8.715497e-01,&
       & 8.720219e-01,8.724669e-01,8.728849e-01,8.732806e-01,8.736550e-01,&
       & 8.740099e-01,8.743435e-01,8.746601e-01,8.749610e-01,8.752449e-01,&
       & 8.755143e-01,8.757688e-01,8.760095e-01,8.762375e-01,8.764532e-01,&
       & 8.766579e-01,8.768506e-01,8.770323e-01,8.772049e-01,8.773690e-01,&
       & 8.775226e-01,8.776679e-01,8.778062e-01,8.779360e-01,8.780587e-01,&
       & 8.781747e-01,8.782852e-01,8.783892e-01,8.784891e-01,8.785824e-01,&
       & 8.786705e-01,8.787546e-01,8.788336e-01 /)
!     BAND  24
      asyliq1(:, 24) = (/ &
       & 8.054324e-01,8.266282e-01,8.378075e-01,8.449848e-01,8.502166e-01,&
       & 8.542268e-01,8.573477e-01,8.598022e-01,8.617689e-01,8.633859e-01,&
       & 8.647536e-01,8.659354e-01,8.669807e-01,8.679143e-01,8.687577e-01,&
       & 8.695222e-01,8.702207e-01,8.708591e-01,8.714446e-01,8.719836e-01,&
       & 8.724812e-01,8.729426e-01,8.733689e-01,8.737665e-01,8.741373e-01,&
       & 8.744834e-01,8.748070e-01,8.751131e-01,8.754011e-01,8.756676e-01,&
       & 8.759219e-01,8.761599e-01,8.763857e-01,8.765984e-01,8.767999e-01,&
       & 8.769889e-01,8.771669e-01,8.773373e-01,8.774969e-01,8.776469e-01,&
       & 8.777894e-01,8.779237e-01,8.780505e-01,8.781703e-01,8.782820e-01,&
       & 8.783886e-01,8.784894e-01,8.785844e-01,8.786736e-01,8.787584e-01,&
       & 8.788379e-01,8.789130e-01,8.789849e-01,8.790506e-01,8.791141e-01,&
       & 8.791750e-01,8.792324e-01,8.792867e-01 /)
!     BAND  25
      asyliq1(:, 25) = (/ &
       & 8.249534e-01,8.391988e-01,8.474107e-01,8.526860e-01,8.563983e-01,&
       & 8.592389e-01,8.615144e-01,8.633790e-01,8.649325e-01,8.662504e-01,&
       & 8.673841e-01,8.683741e-01,8.692495e-01,8.700309e-01,8.707328e-01,&
       & 8.713650e-01,8.719432e-01,8.724676e-01,8.729498e-01,8.733922e-01,&
       & 8.737981e-01,8.741745e-01,8.745225e-01,8.748467e-01,8.751512e-01,&
       & 8.754315e-01,8.756962e-01,8.759450e-01,8.761774e-01,8.763945e-01,&
       & 8.766021e-01,8.767970e-01,8.769803e-01,8.771511e-01,8.773151e-01,&
       & 8.774689e-01,8.776147e-01,8.777533e-01,8.778831e-01,8.780050e-01,&
       & 8.781197e-01,8.782301e-01,8.783323e-01,8.784312e-01,8.785222e-01,&
       & 8.786096e-01,8.786916e-01,8.787688e-01,8.788411e-01,8.789122e-01,&
       & 8.789762e-01,8.790373e-01,8.790954e-01,8.791514e-01,8.792018e-01,&
       & 8.792517e-01,8.792990e-01,8.793429e-01 /)
!     BAND  26
      asyliq1(:, 26) = (/ &
       & 8.323091e-01,8.429776e-01,8.498123e-01,8.546929e-01,8.584295e-01,&
       & 8.613489e-01,8.636324e-01,8.654303e-01,8.668675e-01,8.680404e-01,&
       & 8.690174e-01,8.698495e-01,8.705666e-01,8.711961e-01,8.717556e-01,&
       & 8.722546e-01,8.727063e-01,8.731170e-01,8.734933e-01,8.738382e-01,&
       & 8.741590e-01,8.744525e-01,8.747295e-01,8.749843e-01,8.752210e-01,&
       & 8.754437e-01,8.756524e-01,8.758472e-01,8.760288e-01,8.762030e-01,&
       & 8.763603e-01,8.765122e-01,8.766539e-01,8.767894e-01,8.769130e-01,&
       & 8.770310e-01,8.771422e-01,8.772437e-01,8.773419e-01,8.774355e-01,&
       & 8.775221e-01,8.776047e-01,8.776802e-01,8.777539e-01,8.778216e-01,&
       & 8.778859e-01,8.779473e-01,8.780031e-01,8.780562e-01,8.781097e-01,&
       & 8.781570e-01,8.782021e-01,8.782463e-01,8.782845e-01,8.783235e-01,&
       & 8.783610e-01,8.783953e-01,8.784273e-01 /)
!     BAND  27
      asyliq1(:, 27) = (/ &
       & 8.396448e-01,8.480172e-01,8.535934e-01,8.574145e-01,8.600835e-01,&
       & 8.620347e-01,8.635500e-01,8.648003e-01,8.658758e-01,8.668248e-01,&
       & 8.676697e-01,8.684220e-01,8.690893e-01,8.696807e-01,8.702046e-01,&
       & 8.706676e-01,8.710798e-01,8.714478e-01,8.717778e-01,8.720747e-01,&
       & 8.723431e-01,8.725889e-01,8.728144e-01,8.730201e-01,8.732129e-01,&
       & 8.733907e-01,8.735541e-01,8.737100e-01,8.738533e-01,8.739882e-01,&
       & 8.741164e-01,8.742362e-01,8.743485e-01,8.744530e-01,8.745512e-01,&
       & 8.746471e-01,8.747373e-01,8.748186e-01,8.748973e-01,8.749732e-01,&
       & 8.750443e-01,8.751105e-01,8.751747e-01,8.752344e-01,8.752902e-01,&
       & 8.753412e-01,8.753917e-01,8.754393e-01,8.754843e-01,8.755282e-01,&
       & 8.755662e-01,8.756039e-01,8.756408e-01,8.756722e-01,8.757072e-01,&
       & 8.757352e-01,8.757653e-01,8.757932e-01 /)
!     BAND  28
      asyliq1(:, 28) = (/ &
       & 8.374590e-01,8.465669e-01,8.518701e-01,8.547627e-01,8.565745e-01,&
       & 8.579065e-01,8.589717e-01,8.598632e-01,8.606363e-01,8.613268e-01,&
       & 8.619560e-01,8.625340e-01,8.630689e-01,8.635601e-01,8.640084e-01,&
       & 8.644180e-01,8.647885e-01,8.651220e-01,8.654218e-01,8.656908e-01,&
       & 8.659294e-01,8.661422e-01,8.663334e-01,8.665037e-01,8.666543e-01,&
       & 8.667913e-01,8.669156e-01,8.670242e-01,8.671249e-01,8.672161e-01,&
       & 8.672993e-01,8.673733e-01,8.674457e-01,8.675103e-01,8.675713e-01,&
       & 8.676267e-01,8.676798e-01,8.677286e-01,8.677745e-01,8.678178e-01,&
       & 8.678601e-01,8.678986e-01,8.679351e-01,8.679693e-01,8.680013e-01,&
       & 8.680334e-01,8.680624e-01,8.680915e-01,8.681178e-01,8.681428e-01,&
       & 8.681654e-01,8.681899e-01,8.682103e-01,8.682317e-01,8.682498e-01,&
       & 8.682677e-01,8.682861e-01,8.683041e-01 /)
!     BAND  29
      asyliq1(:, 29) = (/ &
       & 7.877069e-01,8.244281e-01,8.367971e-01,8.409074e-01,8.429859e-01,&
       & 8.454386e-01,8.489350e-01,8.534141e-01,8.585814e-01,8.641267e-01,&
       & 8.697999e-01,8.754223e-01,8.808785e-01,8.860944e-01,8.910354e-01,&
       & 8.956837e-01,9.000392e-01,9.041091e-01,9.079071e-01,9.114479e-01,&
       & 9.147462e-01,9.178234e-01,9.206903e-01,9.233663e-01,9.258668e-01,&
       & 9.282006e-01,9.303847e-01,9.324288e-01,9.343418e-01,9.361356e-01,&
       & 9.378176e-01,9.393939e-01,9.408736e-01,9.422622e-01,9.435670e-01,&
       & 9.447900e-01,9.459395e-01,9.470199e-01,9.480335e-01,9.489852e-01,&
       & 9.498782e-01,9.507168e-01,9.515044e-01,9.522470e-01,9.529409e-01,&
       & 9.535946e-01,9.542071e-01,9.547838e-01,9.553256e-01,9.558351e-01,&
       & 9.563139e-01,9.567660e-01,9.571915e-01,9.575901e-01,9.579685e-01,&
       & 9.583239e-01,9.586602e-01,9.589766e-01 /)


! Spherical Ice Particle Parameterization
! extinction units (ext coef/iwc): [(m^-1)/(g m^-3)]
      extice2(:, 16) = (/ &
! band 16
        & 4.101824e-01 ,2.435514e-01 ,1.713697e-01 ,1.314865e-01 ,1.063406e-01 ,&
        & 8.910701e-02 ,7.659480e-02 ,6.711784e-02 ,5.970353e-02 ,5.375249e-02 ,&
        & 4.887577e-02 ,4.481025e-02 ,4.137171e-02 ,3.842744e-02 ,3.587948e-02 ,&
        & 3.365396e-02 ,3.169419e-02 ,2.995593e-02 ,2.840419e-02 ,2.701091e-02 ,&
        & 2.575336e-02 ,2.461293e-02 ,2.357423e-02 ,2.262443e-02 ,2.175276e-02 ,&
        & 2.095012e-02 ,2.020875e-02 ,1.952199e-02 ,1.888412e-02 ,1.829018e-02 ,&
        & 1.773586e-02 ,1.721738e-02 ,1.673144e-02 ,1.627510e-02 ,1.584579e-02 ,&
        & 1.544122e-02 ,1.505934e-02 ,1.469833e-02 ,1.435654e-02 ,1.403251e-02 ,&
        & 1.372492e-02 ,1.343255e-02 ,1.315433e-02  /)
      extice2(:, 17) = (/ &
! band 17
        & 3.836650e-01 ,2.304055e-01 ,1.637265e-01 ,1.266681e-01 ,1.031602e-01 ,&
        & 8.695191e-02 ,7.511544e-02 ,6.610009e-02 ,5.900909e-02 ,5.328833e-02 ,&
        & 4.857728e-02 ,4.463133e-02 ,4.127880e-02 ,3.839567e-02 ,3.589013e-02 ,&
        & 3.369280e-02 ,3.175027e-02 ,3.002079e-02 ,2.847121e-02 ,2.707493e-02 ,&
        & 2.581031e-02 ,2.465962e-02 ,2.360815e-02 ,2.264363e-02 ,2.175571e-02 ,&
        & 2.093563e-02 ,2.017592e-02 ,1.947015e-02 ,1.881278e-02 ,1.819901e-02 ,&
        & 1.762463e-02 ,1.708598e-02 ,1.657982e-02 ,1.610330e-02 ,1.565390e-02 ,&
        & 1.522937e-02 ,1.482768e-02 ,1.444706e-02 ,1.408588e-02 ,1.374270e-02 ,&
        & 1.341619e-02 ,1.310517e-02 ,1.280857e-02  /)
      extice2(:, 18) = (/ &
! band 18
        & 4.152673e-01 ,2.436816e-01 ,1.702243e-01 ,1.299704e-01 ,1.047528e-01 ,&
        & 8.756039e-02 ,7.513327e-02 ,6.575690e-02 ,5.844616e-02 ,5.259609e-02 ,&
        & 4.781531e-02 ,4.383980e-02 ,4.048517e-02 ,3.761891e-02 ,3.514342e-02 ,&
        & 3.298525e-02 ,3.108814e-02 ,2.940825e-02 ,2.791096e-02 ,2.656858e-02 ,&
        & 2.535869e-02 ,2.426297e-02 ,2.326627e-02 ,2.235602e-02 ,2.152164e-02 ,&
        & 2.075420e-02 ,2.004613e-02 ,1.939091e-02 ,1.878296e-02 ,1.821744e-02 ,&
        & 1.769015e-02 ,1.719741e-02 ,1.673600e-02 ,1.630308e-02 ,1.589615e-02 ,&
        & 1.551298e-02 ,1.515159e-02 ,1.481021e-02 ,1.448726e-02 ,1.418131e-02 ,&
        & 1.389109e-02 ,1.361544e-02 ,1.335330e-02  /)
      extice2(:, 19) = (/ &
! band 19
        & 3.873250e-01 ,2.331609e-01 ,1.655002e-01 ,1.277753e-01 ,1.038247e-01 ,&
        & 8.731780e-02 ,7.527638e-02 ,6.611873e-02 ,5.892850e-02 ,5.313885e-02 ,&
        & 4.838068e-02 ,4.440356e-02 ,4.103167e-02 ,3.813804e-02 ,3.562870e-02 ,&
        & 3.343269e-02 ,3.149539e-02 ,2.977414e-02 ,2.823510e-02 ,2.685112e-02 ,&
        & 2.560015e-02 ,2.446411e-02 ,2.342805e-02 ,2.247948e-02 ,2.160789e-02 ,&
        & 2.080438e-02 ,2.006139e-02 ,1.937238e-02 ,1.873177e-02 ,1.813469e-02 ,&
        & 1.757689e-02 ,1.705468e-02 ,1.656479e-02 ,1.610435e-02 ,1.567081e-02 ,&
        & 1.526192e-02 ,1.487565e-02 ,1.451020e-02 ,1.416396e-02 ,1.383546e-02 ,&
        & 1.352339e-02 ,1.322657e-02 ,1.294392e-02  /)
      extice2(:, 20) = (/ &
! band 20
        & 3.784280e-01 ,2.291396e-01 ,1.632551e-01 ,1.263775e-01 ,1.028944e-01 ,&
        & 8.666975e-02 ,7.480952e-02 ,6.577335e-02 ,5.866714e-02 ,5.293694e-02 ,&
        & 4.822153e-02 ,4.427547e-02 ,4.092626e-02 ,3.804918e-02 ,3.555184e-02 ,&
        & 3.336440e-02 ,3.143307e-02 ,2.971577e-02 ,2.817912e-02 ,2.679632e-02 ,&
        & 2.554558e-02 ,2.440903e-02 ,2.337187e-02 ,2.242173e-02 ,2.154821e-02 ,&
        & 2.074249e-02 ,1.999706e-02 ,1.930546e-02 ,1.866212e-02 ,1.806221e-02 ,&
        & 1.750152e-02 ,1.697637e-02 ,1.648352e-02 ,1.602010e-02 ,1.558358e-02 ,&
        & 1.517172e-02 ,1.478250e-02 ,1.441413e-02 ,1.406498e-02 ,1.373362e-02 ,&
        & 1.341872e-02 ,1.311911e-02 ,1.283371e-02  /)
      extice2(:, 21) = (/ &
! band 21
        & 3.719909e-01 ,2.259490e-01 ,1.613144e-01 ,1.250648e-01 ,1.019462e-01 ,&
        & 8.595358e-02 ,7.425064e-02 ,6.532618e-02 ,5.830218e-02 ,5.263421e-02 ,&
        & 4.796697e-02 ,4.405891e-02 ,4.074013e-02 ,3.788776e-02 ,3.541071e-02 ,&
        & 3.324008e-02 ,3.132280e-02 ,2.961733e-02 ,2.809071e-02 ,2.671645e-02 ,&
        & 2.547302e-02 ,2.434276e-02 ,2.331102e-02 ,2.236558e-02 ,2.149614e-02 ,&
        & 2.069397e-02 ,1.995163e-02 ,1.926272e-02 ,1.862174e-02 ,1.802389e-02 ,&
        & 1.746500e-02 ,1.694142e-02 ,1.644994e-02 ,1.598772e-02 ,1.555225e-02 ,&
        & 1.514129e-02 ,1.475286e-02 ,1.438515e-02 ,1.403659e-02 ,1.370572e-02 ,&
        & 1.339124e-02 ,1.309197e-02 ,1.280685e-02  /)
      extice2(:, 22) = (/ &
! band 22
        & 3.713158e-01 ,2.253816e-01 ,1.608461e-01 ,1.246718e-01 ,1.016109e-01 ,&
        & 8.566332e-02 ,7.399666e-02 ,6.510199e-02 ,5.810290e-02 ,5.245608e-02 ,&
        & 4.780702e-02 ,4.391478e-02 ,4.060989e-02 ,3.776982e-02 ,3.530374e-02 ,&
        & 3.314296e-02 ,3.123458e-02 ,2.953719e-02 ,2.801794e-02 ,2.665043e-02 ,&
        & 2.541321e-02 ,2.428868e-02 ,2.326224e-02 ,2.232173e-02 ,2.145688e-02 ,&
        & 2.065899e-02 ,1.992067e-02 ,1.923552e-02 ,1.859808e-02 ,1.800356e-02 ,&
        & 1.744782e-02 ,1.692721e-02 ,1.643855e-02 ,1.597900e-02 ,1.554606e-02 ,&
        & 1.513751e-02 ,1.475137e-02 ,1.438586e-02 ,1.403938e-02 ,1.371050e-02 ,&
        & 1.339793e-02 ,1.310050e-02 ,1.281713e-02  /)
      extice2(:, 23) = (/ &
! band 23
        & 3.605883e-01 ,2.204388e-01 ,1.580431e-01 ,1.229033e-01 ,1.004203e-01 ,&
        & 8.482616e-02 ,7.338941e-02 ,6.465105e-02 ,5.776176e-02 ,5.219398e-02 ,&
        & 4.760288e-02 ,4.375369e-02 ,4.048111e-02 ,3.766539e-02 ,3.521771e-02 ,&
        & 3.307079e-02 ,3.117277e-02 ,2.948303e-02 ,2.796929e-02 ,2.660560e-02 ,&
        & 2.537086e-02 ,2.424772e-02 ,2.322182e-02 ,2.228114e-02 ,2.141556e-02 ,&
        & 2.061649e-02 ,1.987661e-02 ,1.918962e-02 ,1.855009e-02 ,1.795330e-02 ,&
        & 1.739514e-02 ,1.687199e-02 ,1.638069e-02 ,1.591845e-02 ,1.548276e-02 ,&
        & 1.507143e-02 ,1.468249e-02 ,1.431416e-02 ,1.396486e-02 ,1.363318e-02 ,&
        & 1.331781e-02 ,1.301759e-02 ,1.273147e-02  /)
      extice2(:, 24) = (/ &
! band 24
        & 3.527890e-01 ,2.168469e-01 ,1.560090e-01 ,1.216216e-01 ,9.955787e-02 ,&
        & 8.421942e-02 ,7.294827e-02 ,6.432192e-02 ,5.751081e-02 ,5.199888e-02 ,&
        & 4.744835e-02 ,4.362899e-02 ,4.037847e-02 ,3.757910e-02 ,3.514351e-02 ,&
        & 3.300546e-02 ,3.111382e-02 ,2.942853e-02 ,2.791775e-02 ,2.655584e-02 ,&
        & 2.532195e-02 ,2.419892e-02 ,2.317255e-02 ,2.223092e-02 ,2.136402e-02 ,&
        & 2.056334e-02 ,1.982160e-02 ,1.913258e-02 ,1.849087e-02 ,1.789178e-02 ,&
        & 1.733124e-02 ,1.680565e-02 ,1.631187e-02 ,1.584711e-02 ,1.540889e-02 ,&
        & 1.499502e-02 ,1.460354e-02 ,1.423269e-02 ,1.388088e-02 ,1.354670e-02 ,&
        & 1.322887e-02 ,1.292620e-02 ,1.263767e-02  /)
      extice2(:, 25) = (/ &
! band 25
        & 3.477874e-01 ,2.143515e-01 ,1.544887e-01 ,1.205942e-01 ,9.881779e-02 ,&
        & 8.366261e-02 ,7.251586e-02 ,6.397790e-02 ,5.723183e-02 ,5.176908e-02 ,&
        & 4.725658e-02 ,4.346715e-02 ,4.024055e-02 ,3.746055e-02 ,3.504080e-02 ,&
        & 3.291583e-02 ,3.103507e-02 ,2.935891e-02 ,2.785582e-02 ,2.650042e-02 ,&
        & 2.527206e-02 ,2.415376e-02 ,2.313142e-02 ,2.219326e-02 ,2.132934e-02 ,&
        & 2.053122e-02 ,1.979169e-02 ,1.910456e-02 ,1.846448e-02 ,1.786680e-02 ,&
        & 1.730745e-02 ,1.678289e-02 ,1.628998e-02 ,1.582595e-02 ,1.538835e-02 ,&
        & 1.497499e-02 ,1.458393e-02 ,1.421341e-02 ,1.386187e-02 ,1.352788e-02 ,&
        & 1.321019e-02 ,1.290762e-02 ,1.261913e-02  /)
      extice2(:, 26) = (/ &
! band 26
        & 3.453721e-01 ,2.130744e-01 ,1.536698e-01 ,1.200140e-01 ,9.838078e-02 ,&
        & 8.331940e-02 ,7.223803e-02 ,6.374775e-02 ,5.703770e-02 ,5.160290e-02 ,&
        & 4.711259e-02 ,4.334110e-02 ,4.012923e-02 ,3.736150e-02 ,3.495208e-02 ,&
        & 3.283589e-02 ,3.096267e-02 ,2.929302e-02 ,2.779560e-02 ,2.644517e-02 ,&
        & 2.522119e-02 ,2.410677e-02 ,2.308788e-02 ,2.215281e-02 ,2.129165e-02 ,&
        & 2.049602e-02 ,1.975874e-02 ,1.907365e-02 ,1.843542e-02 ,1.783943e-02 ,&
        & 1.728162e-02 ,1.675847e-02 ,1.626685e-02 ,1.580401e-02 ,1.536750e-02 ,&
        & 1.495515e-02 ,1.456502e-02 ,1.419537e-02 ,1.384463e-02 ,1.351139e-02 ,&
        & 1.319438e-02 ,1.289246e-02 ,1.260456e-02  /)
      extice2(:, 27) = (/ &
! band 27
        & 3.417883e-01 ,2.113379e-01 ,1.526395e-01 ,1.193347e-01 ,9.790253e-02 ,&
        & 8.296715e-02 ,7.196979e-02 ,6.353806e-02 ,5.687024e-02 ,5.146670e-02 ,&
        & 4.700001e-02 ,4.324667e-02 ,4.004894e-02 ,3.729233e-02 ,3.489172e-02 ,&
        & 3.278257e-02 ,3.091499e-02 ,2.924987e-02 ,2.775609e-02 ,2.640859e-02 ,&
        & 2.518695e-02 ,2.407439e-02 ,2.305697e-02 ,2.212303e-02 ,2.126273e-02 ,&
        & 2.046774e-02 ,1.973090e-02 ,1.904610e-02 ,1.840801e-02 ,1.781204e-02 ,&
        & 1.725417e-02 ,1.673086e-02 ,1.623902e-02 ,1.577590e-02 ,1.533906e-02 ,&
        & 1.492634e-02 ,1.453580e-02 ,1.416571e-02 ,1.381450e-02 ,1.348078e-02 ,&
        & 1.316327e-02 ,1.286082e-02 ,1.257240e-02  /)
      extice2(:, 28) = (/ &
! band 28
        & 3.416111e-01 ,2.114124e-01 ,1.527734e-01 ,1.194809e-01 ,9.804612e-02 ,&
        & 8.310287e-02 ,7.209595e-02 ,6.365442e-02 ,5.697710e-02 ,5.156460e-02 ,&
        & 4.708957e-02 ,4.332850e-02 ,4.012361e-02 ,3.736037e-02 ,3.495364e-02 ,&
        & 3.283879e-02 ,3.096593e-02 ,2.929589e-02 ,2.779751e-02 ,2.644571e-02 ,&
        & 2.522004e-02 ,2.410369e-02 ,2.308271e-02 ,2.214542e-02 ,2.128195e-02 ,&
        & 2.048396e-02 ,1.974429e-02 ,1.905679e-02 ,1.841614e-02 ,1.781774e-02 ,&
        & 1.725754e-02 ,1.673203e-02 ,1.623807e-02 ,1.577293e-02 ,1.533416e-02 ,&
        & 1.491958e-02 ,1.452727e-02 ,1.415547e-02 ,1.380262e-02 ,1.346732e-02 ,&
        & 1.314830e-02 ,1.284439e-02 ,1.255456e-02  /)
      extice2(:, 29) = (/ &
! band 29
        & 4.196611e-01 ,2.493642e-01 ,1.761261e-01 ,1.357197e-01 ,1.102161e-01 ,&
        & 9.269376e-02 ,7.992985e-02 ,7.022538e-02 ,6.260168e-02 ,5.645603e-02 ,&
        & 5.139732e-02 ,4.716088e-02 ,4.356133e-02 ,4.046498e-02 ,3.777303e-02 ,&
        & 3.541094e-02 ,3.332137e-02 ,3.145954e-02 ,2.978998e-02 ,2.828419e-02 ,&
        & 2.691905e-02 ,2.567559e-02 ,2.453811e-02 ,2.349350e-02 ,2.253072e-02 ,&
        & 2.164042e-02 ,2.081464e-02 ,2.004652e-02 ,1.933015e-02 ,1.866041e-02 ,&
        & 1.803283e-02 ,1.744348e-02 ,1.688894e-02 ,1.636616e-02 ,1.587244e-02 ,&
        & 1.540539e-02 ,1.496287e-02 ,1.454295e-02 ,1.414392e-02 ,1.376423e-02 ,&
        & 1.340247e-02 ,1.305739e-02 ,1.272784e-02  /)

! single-scattering albedo: unitless
      ssaice2(:, 16) = (/ &
! band 16
        & 6.630615e-01 ,6.451169e-01 ,6.333696e-01 ,6.246927e-01 ,6.178420e-01 ,&
        & 6.121976e-01 ,6.074069e-01 ,6.032505e-01 ,5.995830e-01 ,5.963030e-01 ,&
        & 5.933372e-01 ,5.906311e-01 ,5.881427e-01 ,5.858395e-01 ,5.836955e-01 ,&
        & 5.816896e-01 ,5.798046e-01 ,5.780264e-01 ,5.763429e-01 ,5.747441e-01 ,&
        & 5.732213e-01 ,5.717672e-01 ,5.703754e-01 ,5.690403e-01 ,5.677571e-01 ,&
        & 5.665215e-01 ,5.653297e-01 ,5.641782e-01 ,5.630643e-01 ,5.619850e-01 ,&
        & 5.609381e-01 ,5.599214e-01 ,5.589328e-01 ,5.579707e-01 ,5.570333e-01 ,&
        & 5.561193e-01 ,5.552272e-01 ,5.543558e-01 ,5.535041e-01 ,5.526708e-01 ,&
        & 5.518551e-01 ,5.510561e-01 ,5.502729e-01  /)
      ssaice2(:, 17) = (/ &
! band 17
        & 7.689749e-01 ,7.398171e-01 ,7.205819e-01 ,7.065690e-01 ,6.956928e-01 ,&
        & 6.868989e-01 ,6.795813e-01 ,6.733606e-01 ,6.679838e-01 ,6.632742e-01 ,&
        & 6.591036e-01 ,6.553766e-01 ,6.520197e-01 ,6.489757e-01 ,6.461991e-01 ,&
        & 6.436531e-01 ,6.413075e-01 ,6.391375e-01 ,6.371221e-01 ,6.352438e-01 ,&
        & 6.334876e-01 ,6.318406e-01 ,6.302918e-01 ,6.288315e-01 ,6.274512e-01 ,&
        & 6.261436e-01 ,6.249022e-01 ,6.237211e-01 ,6.225953e-01 ,6.215201e-01 ,&
        & 6.204914e-01 ,6.195055e-01 ,6.185592e-01 ,6.176492e-01 ,6.167730e-01 ,&
        & 6.159280e-01 ,6.151120e-01 ,6.143228e-01 ,6.135587e-01 ,6.128177e-01 ,&
        & 6.120984e-01 ,6.113993e-01 ,6.107189e-01  /)
      ssaice2(:, 18) = (/ &
! band 18
        & 9.956167e-01 ,9.814770e-01 ,9.716104e-01 ,9.639746e-01 ,9.577179e-01 ,&
        & 9.524010e-01 ,9.477672e-01 ,9.436527e-01 ,9.399467e-01 ,9.365708e-01 ,&
        & 9.334672e-01 ,9.305921e-01 ,9.279118e-01 ,9.253993e-01 ,9.230330e-01 ,&
        & 9.207954e-01 ,9.186719e-01 ,9.166501e-01 ,9.147199e-01 ,9.128722e-01 ,&
        & 9.110997e-01 ,9.093956e-01 ,9.077544e-01 ,9.061708e-01 ,9.046406e-01 ,&
        & 9.031598e-01 ,9.017248e-01 ,9.003326e-01 ,8.989804e-01 ,8.976655e-01 ,&
        & 8.963857e-01 ,8.951389e-01 ,8.939233e-01 ,8.927370e-01 ,8.915785e-01 ,&
        & 8.904464e-01 ,8.893392e-01 ,8.882559e-01 ,8.871951e-01 ,8.861559e-01 ,&
        & 8.851373e-01 ,8.841383e-01 ,8.831581e-01  /)
      ssaice2(:, 19) = (/ &
! band 19
        & 9.723177e-01 ,9.452119e-01 ,9.267592e-01 ,9.127393e-01 ,9.014238e-01 ,&
        & 8.919334e-01 ,8.837584e-01 ,8.765773e-01 ,8.701736e-01 ,8.643950e-01 ,&
        & 8.591299e-01 ,8.542942e-01 ,8.498230e-01 ,8.456651e-01 ,8.417794e-01 ,&
        & 8.381324e-01 ,8.346964e-01 ,8.314484e-01 ,8.283687e-01 ,8.254408e-01 ,&
        & 8.226505e-01 ,8.199854e-01 ,8.174348e-01 ,8.149891e-01 ,8.126403e-01 ,&
        & 8.103808e-01 ,8.082041e-01 ,8.061044e-01 ,8.040765e-01 ,8.021156e-01 ,&
        & 8.002174e-01 ,7.983781e-01 ,7.965941e-01 ,7.948622e-01 ,7.931795e-01 ,&
        & 7.915432e-01 ,7.899508e-01 ,7.884002e-01 ,7.868891e-01 ,7.854156e-01 ,&
        & 7.839779e-01 ,7.825742e-01 ,7.812031e-01  /)
      ssaice2(:, 20) = (/ &
! band 20
        & 9.933294e-01 ,9.860917e-01 ,9.811564e-01 ,9.774008e-01 ,9.743652e-01 ,&
        & 9.718155e-01 ,9.696159e-01 ,9.676810e-01 ,9.659531e-01 ,9.643915e-01 ,&
        & 9.629667e-01 ,9.616561e-01 ,9.604426e-01 ,9.593125e-01 ,9.582548e-01 ,&
        & 9.572607e-01 ,9.563227e-01 ,9.554347e-01 ,9.545915e-01 ,9.537888e-01 ,&
        & 9.530226e-01 ,9.522898e-01 ,9.515874e-01 ,9.509130e-01 ,9.502643e-01 ,&
        & 9.496394e-01 ,9.490366e-01 ,9.484542e-01 ,9.478910e-01 ,9.473456e-01 ,&
        & 9.468169e-01 ,9.463039e-01 ,9.458056e-01 ,9.453212e-01 ,9.448499e-01 ,&
        & 9.443910e-01 ,9.439438e-01 ,9.435077e-01 ,9.430821e-01 ,9.426666e-01 ,&
        & 9.422607e-01 ,9.418638e-01 ,9.414756e-01  /)
      ssaice2(:, 21) = (/ &
! band 21
        & 9.900787e-01 ,9.828880e-01 ,9.779258e-01 ,9.741173e-01 ,9.710184e-01 ,&
        & 9.684012e-01 ,9.661332e-01 ,9.641301e-01 ,9.623352e-01 ,9.607083e-01 ,&
        & 9.592198e-01 ,9.578474e-01 ,9.565739e-01 ,9.553856e-01 ,9.542715e-01 ,&
        & 9.532226e-01 ,9.522314e-01 ,9.512919e-01 ,9.503986e-01 ,9.495472e-01 ,&
        & 9.487337e-01 ,9.479549e-01 ,9.472077e-01 ,9.464897e-01 ,9.457985e-01 ,&
        & 9.451322e-01 ,9.444890e-01 ,9.438673e-01 ,9.432656e-01 ,9.426826e-01 ,&
        & 9.421173e-01 ,9.415684e-01 ,9.410351e-01 ,9.405164e-01 ,9.400115e-01 ,&
        & 9.395198e-01 ,9.390404e-01 ,9.385728e-01 ,9.381164e-01 ,9.376707e-01 ,&
        & 9.372350e-01 ,9.368091e-01 ,9.363923e-01  /)
      ssaice2(:, 22) = (/ &
! band 22
        & 9.986793e-01 ,9.985239e-01 ,9.983911e-01 ,9.982715e-01 ,9.981606e-01 ,&
        & 9.980562e-01 ,9.979567e-01 ,9.978613e-01 ,9.977691e-01 ,9.976798e-01 ,&
        & 9.975929e-01 ,9.975081e-01 ,9.974251e-01 ,9.973438e-01 ,9.972640e-01 ,&
        & 9.971855e-01 ,9.971083e-01 ,9.970322e-01 ,9.969571e-01 ,9.968830e-01 ,&
        & 9.968099e-01 ,9.967375e-01 ,9.966660e-01 ,9.965951e-01 ,9.965250e-01 ,&
        & 9.964555e-01 ,9.963867e-01 ,9.963185e-01 ,9.962508e-01 ,9.961836e-01 ,&
        & 9.961170e-01 ,9.960508e-01 ,9.959851e-01 ,9.959198e-01 ,9.958550e-01 ,&
        & 9.957906e-01 ,9.957266e-01 ,9.956629e-01 ,9.955997e-01 ,9.955367e-01 ,&
        & 9.954742e-01 ,9.954119e-01 ,9.953500e-01  /)
      ssaice2(:, 23) = (/ &
! band 23
        & 9.997944e-01 ,9.997791e-01 ,9.997664e-01 ,9.997547e-01 ,9.997436e-01 ,&
        & 9.997327e-01 ,9.997219e-01 ,9.997110e-01 ,9.996999e-01 ,9.996886e-01 ,&
        & 9.996771e-01 ,9.996653e-01 ,9.996533e-01 ,9.996409e-01 ,9.996282e-01 ,&
        & 9.996152e-01 ,9.996019e-01 ,9.995883e-01 ,9.995743e-01 ,9.995599e-01 ,&
        & 9.995453e-01 ,9.995302e-01 ,9.995149e-01 ,9.994992e-01 ,9.994831e-01 ,&
        & 9.994667e-01 ,9.994500e-01 ,9.994329e-01 ,9.994154e-01 ,9.993976e-01 ,&
        & 9.993795e-01 ,9.993610e-01 ,9.993422e-01 ,9.993230e-01 ,9.993035e-01 ,&
        & 9.992837e-01 ,9.992635e-01 ,9.992429e-01 ,9.992221e-01 ,9.992008e-01 ,&
        & 9.991793e-01 ,9.991574e-01 ,9.991352e-01  /)
      ssaice2(:, 24) = (/ &
! band 24
        & 9.999949e-01 ,9.999947e-01 ,9.999943e-01 ,9.999939e-01 ,9.999934e-01 ,&
        & 9.999927e-01 ,9.999920e-01 ,9.999913e-01 ,9.999904e-01 ,9.999895e-01 ,&
        & 9.999885e-01 ,9.999874e-01 ,9.999863e-01 ,9.999851e-01 ,9.999838e-01 ,&
        & 9.999824e-01 ,9.999810e-01 ,9.999795e-01 ,9.999780e-01 ,9.999764e-01 ,&
        & 9.999747e-01 ,9.999729e-01 ,9.999711e-01 ,9.999692e-01 ,9.999673e-01 ,&
        & 9.999653e-01 ,9.999632e-01 ,9.999611e-01 ,9.999589e-01 ,9.999566e-01 ,&
        & 9.999543e-01 ,9.999519e-01 ,9.999495e-01 ,9.999470e-01 ,9.999444e-01 ,&
        & 9.999418e-01 ,9.999392e-01 ,9.999364e-01 ,9.999336e-01 ,9.999308e-01 ,&
        & 9.999279e-01 ,9.999249e-01 ,9.999219e-01  /)
      ssaice2(:, 25) = (/ &
! band 25
        & 9.999997e-01 ,9.999997e-01 ,9.999997e-01 ,9.999996e-01 ,9.999996e-01 ,&
        & 9.999995e-01 ,9.999994e-01 ,9.999993e-01 ,9.999993e-01 ,9.999992e-01 ,&
        & 9.999991e-01 ,9.999989e-01 ,9.999988e-01 ,9.999987e-01 ,9.999986e-01 ,&
        & 9.999984e-01 ,9.999983e-01 ,9.999981e-01 ,9.999980e-01 ,9.999978e-01 ,&
        & 9.999976e-01 ,9.999974e-01 ,9.999972e-01 ,9.999971e-01 ,9.999969e-01 ,&
        & 9.999966e-01 ,9.999964e-01 ,9.999962e-01 ,9.999960e-01 ,9.999957e-01 ,&
        & 9.999955e-01 ,9.999953e-01 ,9.999950e-01 ,9.999947e-01 ,9.999945e-01 ,&
        & 9.999942e-01 ,9.999939e-01 ,9.999936e-01 ,9.999934e-01 ,9.999931e-01 ,&
        & 9.999928e-01 ,9.999925e-01 ,9.999921e-01  /)
      ssaice2(:, 26) = (/ &
! band 26
        & 9.999997e-01 ,9.999996e-01 ,9.999996e-01 ,9.999995e-01 ,9.999994e-01 ,&
        & 9.999993e-01 ,9.999992e-01 ,9.999991e-01 ,9.999990e-01 ,9.999989e-01 ,&
        & 9.999987e-01 ,9.999986e-01 ,9.999984e-01 ,9.999982e-01 ,9.999980e-01 ,&
        & 9.999978e-01 ,9.999976e-01 ,9.999974e-01 ,9.999972e-01 ,9.999970e-01 ,&
        & 9.999967e-01 ,9.999965e-01 ,9.999962e-01 ,9.999959e-01 ,9.999956e-01 ,&
        & 9.999954e-01 ,9.999951e-01 ,9.999947e-01 ,9.999944e-01 ,9.999941e-01 ,&
        & 9.999938e-01 ,9.999934e-01 ,9.999931e-01 ,9.999927e-01 ,9.999923e-01 ,&
        & 9.999920e-01 ,9.999916e-01 ,9.999912e-01 ,9.999908e-01 ,9.999904e-01 ,&
        & 9.999899e-01 ,9.999895e-01 ,9.999891e-01  /)
      ssaice2(:, 27) = (/ &
! band 27
        & 9.999987e-01 ,9.999987e-01 ,9.999985e-01 ,9.999984e-01 ,9.999982e-01 ,&
        & 9.999980e-01 ,9.999978e-01 ,9.999976e-01 ,9.999973e-01 ,9.999970e-01 ,&
        & 9.999967e-01 ,9.999964e-01 ,9.999960e-01 ,9.999956e-01 ,9.999952e-01 ,&
        & 9.999948e-01 ,9.999944e-01 ,9.999939e-01 ,9.999934e-01 ,9.999929e-01 ,&
        & 9.999924e-01 ,9.999918e-01 ,9.999913e-01 ,9.999907e-01 ,9.999901e-01 ,&
        & 9.999894e-01 ,9.999888e-01 ,9.999881e-01 ,9.999874e-01 ,9.999867e-01 ,&
        & 9.999860e-01 ,9.999853e-01 ,9.999845e-01 ,9.999837e-01 ,9.999829e-01 ,&
        & 9.999821e-01 ,9.999813e-01 ,9.999804e-01 ,9.999796e-01 ,9.999787e-01 ,&
        & 9.999778e-01 ,9.999768e-01 ,9.999759e-01  /)
      ssaice2(:, 28) = (/ &
! band 28
        & 9.999989e-01 ,9.999989e-01 ,9.999987e-01 ,9.999986e-01 ,9.999984e-01 ,&
        & 9.999982e-01 ,9.999980e-01 ,9.999978e-01 ,9.999975e-01 ,9.999972e-01 ,&
        & 9.999969e-01 ,9.999966e-01 ,9.999962e-01 ,9.999958e-01 ,9.999954e-01 ,&
        & 9.999950e-01 ,9.999945e-01 ,9.999941e-01 ,9.999936e-01 ,9.999931e-01 ,&
        & 9.999925e-01 ,9.999920e-01 ,9.999914e-01 ,9.999908e-01 ,9.999902e-01 ,&
        & 9.999896e-01 ,9.999889e-01 ,9.999883e-01 ,9.999876e-01 ,9.999869e-01 ,&
        & 9.999861e-01 ,9.999854e-01 ,9.999846e-01 ,9.999838e-01 ,9.999830e-01 ,&
        & 9.999822e-01 ,9.999814e-01 ,9.999805e-01 ,9.999796e-01 ,9.999787e-01 ,&
        & 9.999778e-01 ,9.999769e-01 ,9.999759e-01  /)
      ssaice2(:, 29) = (/ &
! band 29
        & 7.042143e-01 ,6.691161e-01 ,6.463240e-01 ,6.296590e-01 ,6.166381e-01 ,&
        & 6.060183e-01 ,5.970908e-01 ,5.894144e-01 ,5.826968e-01 ,5.767343e-01 ,&
        & 5.713804e-01 ,5.665256e-01 ,5.620867e-01 ,5.579987e-01 ,5.542101e-01 ,&
        & 5.506794e-01 ,5.473727e-01 ,5.442620e-01 ,5.413239e-01 ,5.385389e-01 ,&
        & 5.358901e-01 ,5.333633e-01 ,5.309460e-01 ,5.286277e-01 ,5.263988e-01 ,&
        & 5.242512e-01 ,5.221777e-01 ,5.201719e-01 ,5.182280e-01 ,5.163410e-01 ,&
        & 5.145062e-01 ,5.127197e-01 ,5.109776e-01 ,5.092766e-01 ,5.076137e-01 ,&
        & 5.059860e-01 ,5.043911e-01 ,5.028266e-01 ,5.012904e-01 ,4.997805e-01 ,&
        & 4.982951e-01 ,4.968326e-01 ,4.953913e-01  /)

! asymmetry factor: unitless
      asyice2(:, 16) = (/ &
! band 16
        & 7.946655e-01 ,8.547685e-01 ,8.806016e-01 ,8.949880e-01 ,9.041676e-01 ,&
        & 9.105399e-01 ,9.152249e-01 ,9.188160e-01 ,9.216573e-01 ,9.239620e-01 ,&
        & 9.258695e-01 ,9.274745e-01 ,9.288441e-01 ,9.300267e-01 ,9.310584e-01 ,&
        & 9.319665e-01 ,9.327721e-01 ,9.334918e-01 ,9.341387e-01 ,9.347236e-01 ,&
        & 9.352551e-01 ,9.357402e-01 ,9.361850e-01 ,9.365942e-01 ,9.369722e-01 ,&
        & 9.373225e-01 ,9.376481e-01 ,9.379516e-01 ,9.382352e-01 ,9.385010e-01 ,&
        & 9.387505e-01 ,9.389854e-01 ,9.392070e-01 ,9.394163e-01 ,9.396145e-01 ,&
        & 9.398024e-01 ,9.399809e-01 ,9.401508e-01 ,9.403126e-01 ,9.404670e-01 ,&
        & 9.406144e-01 ,9.407555e-01 ,9.408906e-01  /)
      asyice2(:, 17) = (/ &
! band 17
        & 9.078091e-01 ,9.195850e-01 ,9.267250e-01 ,9.317083e-01 ,9.354632e-01 ,&
        & 9.384323e-01 ,9.408597e-01 ,9.428935e-01 ,9.446301e-01 ,9.461351e-01 ,&
        & 9.474555e-01 ,9.486259e-01 ,9.496722e-01 ,9.506146e-01 ,9.514688e-01 ,&
        & 9.522476e-01 ,9.529612e-01 ,9.536181e-01 ,9.542251e-01 ,9.547883e-01 ,&
        & 9.553124e-01 ,9.558019e-01 ,9.562601e-01 ,9.566904e-01 ,9.570953e-01 ,&
        & 9.574773e-01 ,9.578385e-01 ,9.581806e-01 ,9.585054e-01 ,9.588142e-01 ,&
        & 9.591083e-01 ,9.593888e-01 ,9.596569e-01 ,9.599135e-01 ,9.601593e-01 ,&
        & 9.603952e-01 ,9.606219e-01 ,9.608399e-01 ,9.610499e-01 ,9.612523e-01 ,&
        & 9.614477e-01 ,9.616365e-01 ,9.618192e-01  /)
      asyice2(:, 18) = (/ &
! band 18
        & 8.322045e-01 ,8.528693e-01 ,8.648167e-01 ,8.729163e-01 ,8.789054e-01 ,&
        & 8.835845e-01 ,8.873819e-01 ,8.905511e-01 ,8.932532e-01 ,8.955965e-01 ,&
        & 8.976567e-01 ,8.994887e-01 ,9.011334e-01 ,9.026221e-01 ,9.039791e-01 ,&
        & 9.052237e-01 ,9.063715e-01 ,9.074349e-01 ,9.084245e-01 ,9.093489e-01 ,&
        & 9.102154e-01 ,9.110303e-01 ,9.117987e-01 ,9.125253e-01 ,9.132140e-01 ,&
        & 9.138682e-01 ,9.144910e-01 ,9.150850e-01 ,9.156524e-01 ,9.161955e-01 ,&
        & 9.167160e-01 ,9.172157e-01 ,9.176959e-01 ,9.181581e-01 ,9.186034e-01 ,&
        & 9.190330e-01 ,9.194478e-01 ,9.198488e-01 ,9.202368e-01 ,9.206126e-01 ,&
        & 9.209768e-01 ,9.213301e-01 ,9.216731e-01  /)
      asyice2(:, 19) = (/ &
! band 19
        & 8.116560e-01 ,8.488278e-01 ,8.674331e-01 ,8.788148e-01 ,8.865810e-01 ,&
        & 8.922595e-01 ,8.966149e-01 ,9.000747e-01 ,9.028980e-01 ,9.052513e-01 ,&
        & 9.072468e-01 ,9.089632e-01 ,9.104574e-01 ,9.117713e-01 ,9.129371e-01 ,&
        & 9.139793e-01 ,9.149174e-01 ,9.157668e-01 ,9.165400e-01 ,9.172473e-01 ,&
        & 9.178970e-01 ,9.184962e-01 ,9.190508e-01 ,9.195658e-01 ,9.200455e-01 ,&
        & 9.204935e-01 ,9.209130e-01 ,9.213067e-01 ,9.216771e-01 ,9.220262e-01 ,&
        & 9.223560e-01 ,9.226680e-01 ,9.229636e-01 ,9.232443e-01 ,9.235112e-01 ,&
        & 9.237652e-01 ,9.240074e-01 ,9.242385e-01 ,9.244594e-01 ,9.246708e-01 ,&
        & 9.248733e-01 ,9.250674e-01 ,9.252536e-01  /)
      asyice2(:, 20) = (/ &
! band 20
        & 8.047113e-01 ,8.402864e-01 ,8.570332e-01 ,8.668455e-01 ,8.733206e-01 ,&
        & 8.779272e-01 ,8.813796e-01 ,8.840676e-01 ,8.862225e-01 ,8.879904e-01 ,&
        & 8.894682e-01 ,8.907228e-01 ,8.918019e-01 ,8.927404e-01 ,8.935645e-01 ,&
        & 8.942943e-01 ,8.949452e-01 ,8.955296e-01 ,8.960574e-01 ,8.965366e-01 ,&
        & 8.969736e-01 ,8.973740e-01 ,8.977422e-01 ,8.980820e-01 ,8.983966e-01 ,&
        & 8.986889e-01 ,8.989611e-01 ,8.992153e-01 ,8.994533e-01 ,8.996766e-01 ,&
        & 8.998865e-01 ,9.000843e-01 ,9.002709e-01 ,9.004474e-01 ,9.006146e-01 ,&
        & 9.007731e-01 ,9.009237e-01 ,9.010670e-01 ,9.012034e-01 ,9.013336e-01 ,&
        & 9.014579e-01 ,9.015767e-01 ,9.016904e-01  /)
      asyice2(:, 21) = (/ &
! band 21
        & 8.179122e-01 ,8.480726e-01 ,8.621945e-01 ,8.704354e-01 ,8.758555e-01 ,&
        & 8.797007e-01 ,8.825750e-01 ,8.848078e-01 ,8.865939e-01 ,8.880564e-01 ,&
        & 8.892765e-01 ,8.903105e-01 ,8.911982e-01 ,8.919689e-01 ,8.926446e-01 ,&
        & 8.932419e-01 ,8.937738e-01 ,8.942506e-01 ,8.946806e-01 ,8.950702e-01 ,&
        & 8.954251e-01 ,8.957497e-01 ,8.960477e-01 ,8.963223e-01 ,8.965762e-01 ,&
        & 8.968116e-01 ,8.970306e-01 ,8.972347e-01 ,8.974255e-01 ,8.976042e-01 ,&
        & 8.977720e-01 ,8.979298e-01 ,8.980784e-01 ,8.982188e-01 ,8.983515e-01 ,&
        & 8.984771e-01 ,8.985963e-01 ,8.987095e-01 ,8.988171e-01 ,8.989195e-01 ,&
        & 8.990172e-01 ,8.991104e-01 ,8.991994e-01  /)
      asyice2(:, 22) = (/ &
! band 22
        & 8.169789e-01 ,8.455024e-01 ,8.586925e-01 ,8.663283e-01 ,8.713217e-01 ,&
        & 8.748488e-01 ,8.774765e-01 ,8.795122e-01 ,8.811370e-01 ,8.824649e-01 ,&
        & 8.835711e-01 ,8.845073e-01 ,8.853103e-01 ,8.860068e-01 ,8.866170e-01 ,&
        & 8.871560e-01 ,8.876358e-01 ,8.880658e-01 ,8.884533e-01 ,8.888044e-01 ,&
        & 8.891242e-01 ,8.894166e-01 ,8.896851e-01 ,8.899324e-01 ,8.901612e-01 ,&
        & 8.903733e-01 ,8.905706e-01 ,8.907545e-01 ,8.909265e-01 ,8.910876e-01 ,&
        & 8.912388e-01 ,8.913812e-01 ,8.915153e-01 ,8.916419e-01 ,8.917617e-01 ,&
        & 8.918752e-01 ,8.919829e-01 ,8.920851e-01 ,8.921824e-01 ,8.922751e-01 ,&
        & 8.923635e-01 ,8.924478e-01 ,8.925284e-01  /)
      asyice2(:, 23) = (/ &
! band 23
        & 8.387642e-01 ,8.569979e-01 ,8.658630e-01 ,8.711825e-01 ,8.747605e-01 ,&
        & 8.773472e-01 ,8.793129e-01 ,8.808621e-01 ,8.821179e-01 ,8.831583e-01 ,&
        & 8.840361e-01 ,8.847875e-01 ,8.854388e-01 ,8.860094e-01 ,8.865138e-01 ,&
        & 8.869634e-01 ,8.873668e-01 ,8.877310e-01 ,8.880617e-01 ,8.883635e-01 ,&
        & 8.886401e-01 ,8.888947e-01 ,8.891298e-01 ,8.893477e-01 ,8.895504e-01 ,&
        & 8.897393e-01 ,8.899159e-01 ,8.900815e-01 ,8.902370e-01 ,8.903833e-01 ,&
        & 8.905214e-01 ,8.906518e-01 ,8.907753e-01 ,8.908924e-01 ,8.910036e-01 ,&
        & 8.911094e-01 ,8.912101e-01 ,8.913062e-01 ,8.913979e-01 ,8.914856e-01 ,&
        & 8.915695e-01 ,8.916498e-01 ,8.917269e-01  /)
      asyice2(:, 24) = (/ &
! band 24
        & 8.522208e-01 ,8.648132e-01 ,8.711224e-01 ,8.749901e-01 ,8.776354e-01 ,&
        & 8.795743e-01 ,8.810649e-01 ,8.822518e-01 ,8.832225e-01 ,8.840333e-01 ,&
        & 8.847224e-01 ,8.853162e-01 ,8.858342e-01 ,8.862906e-01 ,8.866962e-01 ,&
        & 8.870595e-01 ,8.873871e-01 ,8.876842e-01 ,8.879551e-01 ,8.882032e-01 ,&
        & 8.884316e-01 ,8.886425e-01 ,8.888380e-01 ,8.890199e-01 ,8.891895e-01 ,&
        & 8.893481e-01 ,8.894968e-01 ,8.896366e-01 ,8.897683e-01 ,8.898926e-01 ,&
        & 8.900102e-01 ,8.901215e-01 ,8.902272e-01 ,8.903276e-01 ,8.904232e-01 ,&
        & 8.905144e-01 ,8.906014e-01 ,8.906845e-01 ,8.907640e-01 ,8.908402e-01 ,&
        & 8.909132e-01 ,8.909834e-01 ,8.910507e-01  /)
      asyice2(:, 25) = (/ &
! band 25
        & 8.578202e-01 ,8.683033e-01 ,8.735431e-01 ,8.767488e-01 ,8.789378e-01 ,&
        & 8.805399e-01 ,8.817701e-01 ,8.827485e-01 ,8.835480e-01 ,8.842152e-01 ,&
        & 8.847817e-01 ,8.852696e-01 ,8.856949e-01 ,8.860694e-01 ,8.864020e-01 ,&
        & 8.866997e-01 ,8.869681e-01 ,8.872113e-01 ,8.874330e-01 ,8.876360e-01 ,&
        & 8.878227e-01 ,8.879951e-01 ,8.881548e-01 ,8.883033e-01 ,8.884418e-01 ,&
        & 8.885712e-01 ,8.886926e-01 ,8.888066e-01 ,8.889139e-01 ,8.890152e-01 ,&
        & 8.891110e-01 ,8.892017e-01 ,8.892877e-01 ,8.893695e-01 ,8.894473e-01 ,&
        & 8.895214e-01 ,8.895921e-01 ,8.896597e-01 ,8.897243e-01 ,8.897862e-01 ,&
        & 8.898456e-01 ,8.899025e-01 ,8.899572e-01  /)
      asyice2(:, 26) = (/ &
! band 26
        & 8.625615e-01 ,8.713831e-01 ,8.755799e-01 ,8.780560e-01 ,8.796983e-01 ,&
        & 8.808714e-01 ,8.817534e-01 ,8.824420e-01 ,8.829953e-01 ,8.834501e-01 ,&
        & 8.838310e-01 ,8.841549e-01 ,8.844338e-01 ,8.846767e-01 ,8.848902e-01 ,&
        & 8.850795e-01 ,8.852484e-01 ,8.854002e-01 ,8.855374e-01 ,8.856620e-01 ,&
        & 8.857758e-01 ,8.858800e-01 ,8.859759e-01 ,8.860644e-01 ,8.861464e-01 ,&
        & 8.862225e-01 ,8.862935e-01 ,8.863598e-01 ,8.864218e-01 ,8.864800e-01 ,&
        & 8.865347e-01 ,8.865863e-01 ,8.866349e-01 ,8.866809e-01 ,8.867245e-01 ,&
        & 8.867658e-01 ,8.868050e-01 ,8.868423e-01 ,8.868778e-01 ,8.869117e-01 ,&
        & 8.869440e-01 ,8.869749e-01 ,8.870044e-01  /)
      asyice2(:, 27) = (/ &
! band 27
        & 8.587495e-01 ,8.684764e-01 ,8.728189e-01 ,8.752872e-01 ,8.768846e-01 ,&
        & 8.780060e-01 ,8.788386e-01 ,8.794824e-01 ,8.799960e-01 ,8.804159e-01 ,&
        & 8.807660e-01 ,8.810626e-01 ,8.813175e-01 ,8.815390e-01 ,8.817335e-01 ,&
        & 8.819057e-01 ,8.820593e-01 ,8.821973e-01 ,8.823220e-01 ,8.824353e-01 ,&
        & 8.825387e-01 ,8.826336e-01 ,8.827209e-01 ,8.828016e-01 ,8.828764e-01 ,&
        & 8.829459e-01 ,8.830108e-01 ,8.830715e-01 ,8.831283e-01 ,8.831817e-01 ,&
        & 8.832320e-01 ,8.832795e-01 ,8.833244e-01 ,8.833668e-01 ,8.834071e-01 ,&
        & 8.834454e-01 ,8.834817e-01 ,8.835164e-01 ,8.835495e-01 ,8.835811e-01 ,&
        & 8.836113e-01 ,8.836402e-01 ,8.836679e-01  /)
      asyice2(:, 28) = (/ &
! band 28
        & 8.561110e-01 ,8.678583e-01 ,8.727554e-01 ,8.753892e-01 ,8.770154e-01 ,&
        & 8.781109e-01 ,8.788949e-01 ,8.794812e-01 ,8.799348e-01 ,8.802952e-01 ,&
        & 8.805880e-01 ,8.808300e-01 ,8.810331e-01 ,8.812058e-01 ,8.813543e-01 ,&
        & 8.814832e-01 ,8.815960e-01 ,8.816956e-01 ,8.817839e-01 ,8.818629e-01 ,&
        & 8.819339e-01 ,8.819979e-01 ,8.820560e-01 ,8.821089e-01 ,8.821573e-01 ,&
        & 8.822016e-01 ,8.822425e-01 ,8.822801e-01 ,8.823150e-01 ,8.823474e-01 ,&
        & 8.823775e-01 ,8.824056e-01 ,8.824318e-01 ,8.824564e-01 ,8.824795e-01 ,&
        & 8.825011e-01 ,8.825215e-01 ,8.825408e-01 ,8.825589e-01 ,8.825761e-01 ,&
        & 8.825924e-01 ,8.826078e-01 ,8.826224e-01  /)
      asyice2(:, 29) = (/ &
! band 29
        & 8.311124e-01 ,8.688197e-01 ,8.900274e-01 ,9.040696e-01 ,9.142334e-01 ,&
        & 9.220181e-01 ,9.282195e-01 ,9.333048e-01 ,9.375689e-01 ,9.412085e-01 ,&
        & 9.443604e-01 ,9.471230e-01 ,9.495694e-01 ,9.517549e-01 ,9.537224e-01 ,&
        & 9.555057e-01 ,9.571316e-01 ,9.586222e-01 ,9.599952e-01 ,9.612656e-01 ,&
        & 9.624458e-01 ,9.635461e-01 ,9.645756e-01 ,9.655418e-01 ,9.664513e-01 ,&
        & 9.673098e-01 ,9.681222e-01 ,9.688928e-01 ,9.696256e-01 ,9.703237e-01 ,&
        & 9.709903e-01 ,9.716280e-01 ,9.722391e-01 ,9.728258e-01 ,9.733901e-01 ,&
        & 9.739336e-01 ,9.744579e-01 ,9.749645e-01 ,9.754546e-01 ,9.759294e-01 ,&
        & 9.763901e-01 ,9.768376e-01 ,9.772727e-01  /)

! Hexagonal Ice Particle Parameterization
! extinction units (ext coef/iwc): [(m^-1)/(g m^-3)]
      extice3(:, 16) = (/ &
! band 16
        & 5.194013e-01 ,3.215089e-01 ,2.327917e-01 ,1.824424e-01 ,1.499977e-01 ,&
        & 1.273492e-01 ,1.106421e-01 ,9.780982e-02 ,8.764435e-02 ,7.939266e-02 ,&
        & 7.256081e-02 ,6.681137e-02 ,6.190600e-02 ,5.767154e-02 ,5.397915e-02 ,&
        & 5.073102e-02 ,4.785151e-02 ,4.528125e-02 ,4.297296e-02 ,4.088853e-02 ,&
        & 3.899690e-02 ,3.727251e-02 ,3.569411e-02 ,3.424393e-02 ,3.290694e-02 ,&
        & 3.167040e-02 ,3.052340e-02 ,2.945654e-02 ,2.846172e-02 ,2.753188e-02 ,&
        & 2.666085e-02 ,2.584322e-02 ,2.507423e-02 ,2.434967e-02 ,2.366579e-02 ,&
        & 2.301926e-02 ,2.240711e-02 ,2.182666e-02 ,2.127551e-02 ,2.075150e-02 ,&
        & 2.025267e-02 ,1.977725e-02 ,1.932364e-02 ,1.889035e-02 ,1.847607e-02 ,&
        & 1.807956e-02  /)
      extice3(:, 17) = (/ &
! band 17
        & 4.901155e-01 ,3.065286e-01 ,2.230800e-01 ,1.753951e-01 ,1.445402e-01 ,&
        & 1.229417e-01 ,1.069777e-01 ,9.469760e-02 ,8.495824e-02 ,7.704501e-02 ,&
        & 7.048834e-02 ,6.496693e-02 ,6.025353e-02 ,5.618286e-02 ,5.263186e-02 ,&
        & 4.950698e-02 ,4.673585e-02 ,4.426164e-02 ,4.203904e-02 ,4.003153e-02 ,&
        & 3.820932e-02 ,3.654790e-02 ,3.502688e-02 ,3.362919e-02 ,3.234041e-02 ,&
        & 3.114829e-02 ,3.004234e-02 ,2.901356e-02 ,2.805413e-02 ,2.715727e-02 ,&
        & 2.631705e-02 ,2.552828e-02 ,2.478637e-02 ,2.408725e-02 ,2.342734e-02 ,&
        & 2.280343e-02 ,2.221264e-02 ,2.165242e-02 ,2.112043e-02 ,2.061461e-02 ,&
        & 2.013308e-02 ,1.967411e-02 ,1.923616e-02 ,1.881783e-02 ,1.841781e-02 ,&
        & 1.803494e-02  /)
      extice3(:, 18) = (/ &
! band 18
        & 5.056264e-01 ,3.160261e-01 ,2.298442e-01 ,1.805973e-01 ,1.487318e-01 ,&
        & 1.264258e-01 ,1.099389e-01 ,9.725656e-02 ,8.719819e-02 ,7.902576e-02 ,&
        & 7.225433e-02 ,6.655206e-02 ,6.168427e-02 ,5.748028e-02 ,5.381296e-02 ,&
        & 5.058572e-02 ,4.772383e-02 ,4.516857e-02 ,4.287317e-02 ,4.079990e-02 ,&
        & 3.891801e-02 ,3.720217e-02 ,3.563133e-02 ,3.418786e-02 ,3.285686e-02 ,&
        & 3.162569e-02 ,3.048352e-02 ,2.942104e-02 ,2.843018e-02 ,2.750395e-02 ,&
        & 2.663621e-02 ,2.582160e-02 ,2.505539e-02 ,2.433337e-02 ,2.365185e-02 ,&
        & 2.300750e-02 ,2.239736e-02 ,2.181878e-02 ,2.126937e-02 ,2.074699e-02 ,&
        & 2.024968e-02 ,1.977567e-02 ,1.932338e-02 ,1.889134e-02 ,1.847823e-02 ,&
        & 1.808281e-02  /)
      extice3(:, 19) = (/ &
! band 19
        & 4.881605e-01 ,3.055237e-01 ,2.225070e-01 ,1.750688e-01 ,1.443736e-01 ,&
        & 1.228869e-01 ,1.070054e-01 ,9.478893e-02 ,8.509997e-02 ,7.722769e-02 ,&
        & 7.070495e-02 ,6.521211e-02 ,6.052311e-02 ,5.647351e-02 ,5.294088e-02 ,&
        & 4.983217e-02 ,4.707539e-02 ,4.461398e-02 ,4.240288e-02 ,4.040575e-02 ,&
        & 3.859298e-02 ,3.694016e-02 ,3.542701e-02 ,3.403655e-02 ,3.275444e-02 ,&
        & 3.156849e-02 ,3.046827e-02 ,2.944481e-02 ,2.849034e-02 ,2.759812e-02 ,&
        & 2.676226e-02 ,2.597757e-02 ,2.523949e-02 ,2.454400e-02 ,2.388750e-02 ,&
        & 2.326682e-02 ,2.267909e-02 ,2.212176e-02 ,2.159253e-02 ,2.108933e-02 ,&
        & 2.061028e-02 ,2.015369e-02 ,1.971801e-02 ,1.930184e-02 ,1.890389e-02 ,&
        & 1.852300e-02  /)
      extice3(:, 20) = (/ &
! band 20
        & 5.103703e-01 ,3.188144e-01 ,2.317435e-01 ,1.819887e-01 ,1.497944e-01 ,&
        & 1.272584e-01 ,1.106013e-01 ,9.778822e-02 ,8.762610e-02 ,7.936938e-02 ,&
        & 7.252809e-02 ,6.676701e-02 ,6.184901e-02 ,5.760165e-02 ,5.389651e-02 ,&
        & 5.063598e-02 ,4.774457e-02 ,4.516295e-02 ,4.284387e-02 ,4.074922e-02 ,&
        & 3.884792e-02 ,3.711438e-02 ,3.552734e-02 ,3.406898e-02 ,3.272425e-02 ,&
        & 3.148038e-02 ,3.032643e-02 ,2.925299e-02 ,2.825191e-02 ,2.731612e-02 ,&
        & 2.643943e-02 ,2.561642e-02 ,2.484230e-02 ,2.411284e-02 ,2.342429e-02 ,&
        & 2.277329e-02 ,2.215686e-02 ,2.157231e-02 ,2.101724e-02 ,2.048946e-02 ,&
        & 1.998702e-02 ,1.950813e-02 ,1.905118e-02 ,1.861468e-02 ,1.819730e-02 ,&
        & 1.779781e-02  /)
      extice3(:, 21) = (/ &
! band 21
        & 5.031161e-01 ,3.144511e-01 ,2.286942e-01 ,1.796903e-01 ,1.479819e-01 ,&
        & 1.257860e-01 ,1.093803e-01 ,9.676059e-02 ,8.675183e-02 ,7.861971e-02 ,&
        & 7.188168e-02 ,6.620754e-02 ,6.136376e-02 ,5.718050e-02 ,5.353127e-02 ,&
        & 5.031995e-02 ,4.747218e-02 ,4.492952e-02 ,4.264544e-02 ,4.058240e-02 ,&
        & 3.870979e-02 ,3.700242e-02 ,3.543933e-02 ,3.400297e-02 ,3.267854e-02 ,&
        & 3.145345e-02 ,3.031691e-02 ,2.925967e-02 ,2.827370e-02 ,2.735203e-02 ,&
        & 2.648858e-02 ,2.567798e-02 ,2.491555e-02 ,2.419710e-02 ,2.351893e-02 ,&
        & 2.287776e-02 ,2.227063e-02 ,2.169491e-02 ,2.114821e-02 ,2.062840e-02 ,&
        & 2.013354e-02 ,1.966188e-02 ,1.921182e-02 ,1.878191e-02 ,1.837083e-02 ,&
        & 1.797737e-02  /)
      extice3(:, 22) = (/ &
! band 22
        & 4.949453e-01 ,3.095918e-01 ,2.253402e-01 ,1.771964e-01 ,1.460446e-01 ,&
        & 1.242383e-01 ,1.081206e-01 ,9.572235e-02 ,8.588928e-02 ,7.789990e-02 ,&
        & 7.128013e-02 ,6.570559e-02 ,6.094684e-02 ,5.683701e-02 ,5.325183e-02 ,&
        & 5.009688e-02 ,4.729909e-02 ,4.480106e-02 ,4.255708e-02 ,4.053025e-02 ,&
        & 3.869051e-02 ,3.701310e-02 ,3.547745e-02 ,3.406631e-02 ,3.276512e-02 ,&
        & 3.156153e-02 ,3.044494e-02 ,2.940626e-02 ,2.843759e-02 ,2.753211e-02 ,&
        & 2.668381e-02 ,2.588744e-02 ,2.513839e-02 ,2.443255e-02 ,2.376629e-02 ,&
        & 2.313637e-02 ,2.253990e-02 ,2.197428e-02 ,2.143718e-02 ,2.092649e-02 ,&
        & 2.044032e-02 ,1.997694e-02 ,1.953478e-02 ,1.911241e-02 ,1.870855e-02 ,&
        & 1.832199e-02  /)
      extice3(:, 23) = (/ &
! band 23
        & 5.052816e-01 ,3.157665e-01 ,2.296233e-01 ,1.803986e-01 ,1.485473e-01 ,&
        & 1.262514e-01 ,1.097718e-01 ,9.709524e-02 ,8.704139e-02 ,7.887264e-02 ,&
        & 7.210424e-02 ,6.640454e-02 ,6.153894e-02 ,5.733683e-02 ,5.367116e-02 ,&
        & 5.044537e-02 ,4.758477e-02 ,4.503066e-02 ,4.273629e-02 ,4.066395e-02 ,&
        & 3.878291e-02 ,3.706784e-02 ,3.549771e-02 ,3.405488e-02 ,3.272448e-02 ,&
        & 3.149387e-02 ,3.035221e-02 ,2.929020e-02 ,2.829979e-02 ,2.737397e-02 ,&
        & 2.650663e-02 ,2.569238e-02 ,2.492651e-02 ,2.420482e-02 ,2.352361e-02 ,&
        & 2.287954e-02 ,2.226968e-02 ,2.169136e-02 ,2.114220e-02 ,2.062005e-02 ,&
        & 2.012296e-02 ,1.964917e-02 ,1.919709e-02 ,1.876524e-02 ,1.835231e-02 ,&
        & 1.795707e-02  /)
      extice3(:, 24) = (/ &
! band 24
        & 5.042067e-01 ,3.151195e-01 ,2.291708e-01 ,1.800573e-01 ,1.482779e-01 ,&
        & 1.260324e-01 ,1.095900e-01 ,9.694202e-02 ,8.691087e-02 ,7.876056e-02 ,&
        & 7.200745e-02 ,6.632062e-02 ,6.146600e-02 ,5.727338e-02 ,5.361599e-02 ,&
        & 5.039749e-02 ,4.754334e-02 ,4.499500e-02 ,4.270580e-02 ,4.063815e-02 ,&
        & 3.876135e-02 ,3.705016e-02 ,3.548357e-02 ,3.404400e-02 ,3.271661e-02 ,&
        & 3.148877e-02 ,3.034969e-02 ,2.929008e-02 ,2.830191e-02 ,2.737818e-02 ,&
        & 2.651279e-02 ,2.570039e-02 ,2.493624e-02 ,2.421618e-02 ,2.353650e-02 ,&
        & 2.289390e-02 ,2.228541e-02 ,2.170840e-02 ,2.116048e-02 ,2.063950e-02 ,&
        & 2.014354e-02 ,1.967082e-02 ,1.921975e-02 ,1.878888e-02 ,1.837688e-02 ,&
        & 1.798254e-02  /)
      extice3(:, 25) = (/ &
! band 25
        & 5.022507e-01 ,3.139246e-01 ,2.283218e-01 ,1.794059e-01 ,1.477544e-01 ,&
        & 1.255984e-01 ,1.092222e-01 ,9.662516e-02 ,8.663439e-02 ,7.851688e-02 ,&
        & 7.179095e-02 ,6.612700e-02 ,6.129193e-02 ,5.711618e-02 ,5.347351e-02 ,&
        & 5.026796e-02 ,4.742530e-02 ,4.488721e-02 ,4.260724e-02 ,4.054790e-02 ,&
        & 3.867866e-02 ,3.697435e-02 ,3.541407e-02 ,3.398029e-02 ,3.265824e-02 ,&
        & 3.143535e-02 ,3.030085e-02 ,2.924551e-02 ,2.826131e-02 ,2.734130e-02 ,&
        & 2.647939e-02 ,2.567026e-02 ,2.490919e-02 ,2.419203e-02 ,2.351509e-02 ,&
        & 2.287507e-02 ,2.226903e-02 ,2.169434e-02 ,2.114862e-02 ,2.062975e-02 ,&
        & 2.013578e-02 ,1.966496e-02 ,1.921571e-02 ,1.878658e-02 ,1.837623e-02 ,&
        & 1.798348e-02  /)
      extice3(:, 26) = (/ &
! band 26
        & 5.068316e-01 ,3.166869e-01 ,2.302576e-01 ,1.808693e-01 ,1.489122e-01 ,&
        & 1.265423e-01 ,1.100080e-01 ,9.728926e-02 ,8.720201e-02 ,7.900612e-02 ,&
        & 7.221524e-02 ,6.649660e-02 ,6.161484e-02 ,5.739877e-02 ,5.372093e-02 ,&
        & 5.048442e-02 ,4.761431e-02 ,4.505172e-02 ,4.274972e-02 ,4.067050e-02 ,&
        & 3.878321e-02 ,3.706244e-02 ,3.548710e-02 ,3.403948e-02 ,3.270466e-02 ,&
        & 3.146995e-02 ,3.032450e-02 ,2.925897e-02 ,2.826527e-02 ,2.733638e-02 ,&
        & 2.646615e-02 ,2.564920e-02 ,2.488078e-02 ,2.415670e-02 ,2.347322e-02 ,&
        & 2.282702e-02 ,2.221513e-02 ,2.163489e-02 ,2.108390e-02 ,2.056002e-02 ,&
        & 2.006128e-02 ,1.958591e-02 ,1.913232e-02 ,1.869904e-02 ,1.828474e-02 ,&
        & 1.788819e-02  /)
      extice3(:, 27) = (/ &
! band 27
        & 5.077707e-01 ,3.172636e-01 ,2.306695e-01 ,1.811871e-01 ,1.491691e-01 ,&
        & 1.267565e-01 ,1.101907e-01 ,9.744773e-02 ,8.734125e-02 ,7.912973e-02 ,&
        & 7.232591e-02 ,6.659637e-02 ,6.170530e-02 ,5.748120e-02 ,5.379634e-02 ,&
        & 5.055367e-02 ,4.767809e-02 ,4.511061e-02 ,4.280423e-02 ,4.072104e-02 ,&
        & 3.883015e-02 ,3.710611e-02 ,3.552776e-02 ,3.407738e-02 ,3.274002e-02 ,&
        & 3.150296e-02 ,3.035532e-02 ,2.928776e-02 ,2.829216e-02 ,2.736150e-02 ,&
        & 2.648961e-02 ,2.567111e-02 ,2.490123e-02 ,2.417576e-02 ,2.349098e-02 ,&
        & 2.284354e-02 ,2.223049e-02 ,2.164914e-02 ,2.109711e-02 ,2.057222e-02 ,&
        & 2.007253e-02 ,1.959626e-02 ,1.914181e-02 ,1.870770e-02 ,1.829261e-02 ,&
        & 1.789531e-02  /)
      extice3(:, 28) = (/ &
! band 28
        & 5.062281e-01 ,3.163402e-01 ,2.300275e-01 ,1.807060e-01 ,1.487921e-01 ,&
        & 1.264523e-01 ,1.099403e-01 ,9.723879e-02 ,8.716516e-02 ,7.898034e-02 ,&
        & 7.219863e-02 ,6.648771e-02 ,6.161254e-02 ,5.740217e-02 ,5.372929e-02 ,&
        & 5.049716e-02 ,4.763092e-02 ,4.507179e-02 ,4.277290e-02 ,4.069649e-02 ,&
        & 3.881175e-02 ,3.709331e-02 ,3.552008e-02 ,3.407442e-02 ,3.274141e-02 ,&
        & 3.150837e-02 ,3.036447e-02 ,2.930037e-02 ,2.830801e-02 ,2.738037e-02 ,&
        & 2.651132e-02 ,2.569547e-02 ,2.492810e-02 ,2.420499e-02 ,2.352243e-02 ,&
        & 2.287710e-02 ,2.226604e-02 ,2.168658e-02 ,2.113634e-02 ,2.061316e-02 ,&
        & 2.011510e-02 ,1.964038e-02 ,1.918740e-02 ,1.875471e-02 ,1.834096e-02 ,&
        & 1.794495e-02  /)
      extice3(:, 29) = (/ &
! band 29
        & 1.338834e-01 ,1.924912e-01 ,1.755523e-01 ,1.534793e-01 ,1.343937e-01 ,&
        & 1.187883e-01 ,1.060654e-01 ,9.559106e-02 ,8.685880e-02 ,7.948698e-02 ,&
        & 7.319086e-02 ,6.775669e-02 ,6.302215e-02 ,5.886236e-02 ,5.517996e-02 ,&
        & 5.189810e-02 ,4.895539e-02 ,4.630225e-02 ,4.389823e-02 ,4.171002e-02 ,&
        & 3.970998e-02 ,3.787493e-02 ,3.618537e-02 ,3.462471e-02 ,3.317880e-02 ,&
        & 3.183547e-02 ,3.058421e-02 ,2.941590e-02 ,2.832256e-02 ,2.729724e-02 ,&
        & 2.633377e-02 ,2.542675e-02 ,2.457136e-02 ,2.376332e-02 ,2.299882e-02 ,&
        & 2.227443e-02 ,2.158707e-02 ,2.093400e-02 ,2.031270e-02 ,1.972091e-02 ,&
        & 1.915659e-02 ,1.861787e-02 ,1.810304e-02 ,1.761055e-02 ,1.713899e-02 ,&
        & 1.668704e-02  /)

! single-scattering albedo: unitless
      ssaice3(:, 16) = (/ &
! band 16
        & 6.749442e-01 ,6.649947e-01 ,6.565828e-01 ,6.489928e-01 ,6.420046e-01 ,&
        & 6.355231e-01 ,6.294964e-01 ,6.238901e-01 ,6.186783e-01 ,6.138395e-01 ,&
        & 6.093543e-01 ,6.052049e-01 ,6.013742e-01 ,5.978457e-01 ,5.946030e-01 ,&
        & 5.916302e-01 ,5.889115e-01 ,5.864310e-01 ,5.841731e-01 ,5.821221e-01 ,&
        & 5.802624e-01 ,5.785785e-01 ,5.770549e-01 ,5.756759e-01 ,5.744262e-01 ,&
        & 5.732901e-01 ,5.722524e-01 ,5.712974e-01 ,5.704097e-01 ,5.695739e-01 ,&
        & 5.687747e-01 ,5.679964e-01 ,5.672238e-01 ,5.664415e-01 ,5.656340e-01 ,&
        & 5.647860e-01 ,5.638821e-01 ,5.629070e-01 ,5.618452e-01 ,5.606815e-01 ,&
        & 5.594006e-01 ,5.579870e-01 ,5.564255e-01 ,5.547008e-01 ,5.527976e-01 ,&
        & 5.507005e-01  /)
      ssaice3(:, 17) = (/ &
! band 17
        & 7.628550e-01 ,7.567297e-01 ,7.508463e-01 ,7.451972e-01 ,7.397745e-01 ,&
        & 7.345705e-01 ,7.295775e-01 ,7.247881e-01 ,7.201945e-01 ,7.157894e-01 ,&
        & 7.115652e-01 ,7.075145e-01 ,7.036300e-01 ,6.999044e-01 ,6.963304e-01 ,&
        & 6.929007e-01 ,6.896083e-01 ,6.864460e-01 ,6.834067e-01 ,6.804833e-01 ,&
        & 6.776690e-01 ,6.749567e-01 ,6.723397e-01 ,6.698109e-01 ,6.673637e-01 ,&
        & 6.649913e-01 ,6.626870e-01 ,6.604441e-01 ,6.582561e-01 ,6.561163e-01 ,&
        & 6.540182e-01 ,6.519554e-01 ,6.499215e-01 ,6.479099e-01 ,6.459145e-01 ,&
        & 6.439289e-01 ,6.419468e-01 ,6.399621e-01 ,6.379686e-01 ,6.359601e-01 ,&
        & 6.339306e-01 ,6.318740e-01 ,6.297845e-01 ,6.276559e-01 ,6.254825e-01 ,&
        & 6.232583e-01  /)
      ssaice3(:, 18) = (/ &
! band 18
        & 9.924147e-01 ,9.882792e-01 ,9.842257e-01 ,9.802522e-01 ,9.763566e-01 ,&
        & 9.725367e-01 ,9.687905e-01 ,9.651157e-01 ,9.615104e-01 ,9.579725e-01 ,&
        & 9.544997e-01 ,9.510901e-01 ,9.477416e-01 ,9.444520e-01 ,9.412194e-01 ,&
        & 9.380415e-01 ,9.349165e-01 ,9.318421e-01 ,9.288164e-01 ,9.258373e-01 ,&
        & 9.229027e-01 ,9.200106e-01 ,9.171589e-01 ,9.143457e-01 ,9.115688e-01 ,&
        & 9.088263e-01 ,9.061161e-01 ,9.034362e-01 ,9.007846e-01 ,8.981592e-01 ,&
        & 8.955581e-01 ,8.929792e-01 ,8.904206e-01 ,8.878803e-01 ,8.853562e-01 ,&
        & 8.828464e-01 ,8.803488e-01 ,8.778616e-01 ,8.753827e-01 ,8.729102e-01 ,&
        & 8.704421e-01 ,8.679764e-01 ,8.655112e-01 ,8.630445e-01 ,8.605744e-01 ,&
        & 8.580989e-01  /)
      ssaice3(:, 19) = (/ &
! band 19
        & 9.629413e-01 ,9.517182e-01 ,9.409209e-01 ,9.305366e-01 ,9.205529e-01 ,&
        & 9.109569e-01 ,9.017362e-01 ,8.928780e-01 ,8.843699e-01 ,8.761992e-01 ,&
        & 8.683536e-01 ,8.608204e-01 ,8.535873e-01 ,8.466417e-01 ,8.399712e-01 ,&
        & 8.335635e-01 ,8.274062e-01 ,8.214868e-01 ,8.157932e-01 ,8.103129e-01 ,&
        & 8.050336e-01 ,7.999432e-01 ,7.950294e-01 ,7.902798e-01 ,7.856825e-01 ,&
        & 7.812250e-01 ,7.768954e-01 ,7.726815e-01 ,7.685711e-01 ,7.645522e-01 ,&
        & 7.606126e-01 ,7.567404e-01 ,7.529234e-01 ,7.491498e-01 ,7.454074e-01 ,&
        & 7.416844e-01 ,7.379688e-01 ,7.342485e-01 ,7.305118e-01 ,7.267468e-01 ,&
        & 7.229415e-01 ,7.190841e-01 ,7.151628e-01 ,7.111657e-01 ,7.070811e-01 ,&
        & 7.028972e-01  /)
      ssaice3(:, 20) = (/ &
! band 20
        & 9.942270e-01 ,9.909206e-01 ,9.876775e-01 ,9.844960e-01 ,9.813746e-01 ,&
        & 9.783114e-01 ,9.753049e-01 ,9.723535e-01 ,9.694553e-01 ,9.666088e-01 ,&
        & 9.638123e-01 ,9.610641e-01 ,9.583626e-01 ,9.557060e-01 ,9.530928e-01 ,&
        & 9.505211e-01 ,9.479895e-01 ,9.454961e-01 ,9.430393e-01 ,9.406174e-01 ,&
        & 9.382288e-01 ,9.358717e-01 ,9.335446e-01 ,9.312456e-01 ,9.289731e-01 ,&
        & 9.267255e-01 ,9.245010e-01 ,9.222980e-01 ,9.201147e-01 ,9.179496e-01 ,&
        & 9.158008e-01 ,9.136667e-01 ,9.115457e-01 ,9.094359e-01 ,9.073358e-01 ,&
        & 9.052436e-01 ,9.031577e-01 ,9.010763e-01 ,8.989977e-01 ,8.969203e-01 ,&
        & 8.948423e-01 ,8.927620e-01 ,8.906778e-01 ,8.885879e-01 ,8.864907e-01 ,&
        & 8.843843e-01  /)
      ssaice3(:, 21) = (/ &
! band 21
        & 9.934014e-01 ,9.899331e-01 ,9.865537e-01 ,9.832610e-01 ,9.800523e-01 ,&
        & 9.769254e-01 ,9.738777e-01 ,9.709069e-01 ,9.680106e-01 ,9.651862e-01 ,&
        & 9.624315e-01 ,9.597439e-01 ,9.571212e-01 ,9.545608e-01 ,9.520605e-01 ,&
        & 9.496177e-01 ,9.472301e-01 ,9.448954e-01 ,9.426111e-01 ,9.403749e-01 ,&
        & 9.381843e-01 ,9.360370e-01 ,9.339307e-01 ,9.318629e-01 ,9.298313e-01 ,&
        & 9.278336e-01 ,9.258673e-01 ,9.239302e-01 ,9.220198e-01 ,9.201338e-01 ,&
        & 9.182700e-01 ,9.164258e-01 ,9.145991e-01 ,9.127874e-01 ,9.109884e-01 ,&
        & 9.091999e-01 ,9.074194e-01 ,9.056447e-01 ,9.038735e-01 ,9.021033e-01 ,&
        & 9.003320e-01 ,8.985572e-01 ,8.967766e-01 ,8.949879e-01 ,8.931888e-01 ,&
        & 8.913770e-01  /)
      ssaice3(:, 22) = (/ &
! band 22
        & 9.994833e-01 ,9.992055e-01 ,9.989278e-01 ,9.986500e-01 ,9.983724e-01 ,&
        & 9.980947e-01 ,9.978172e-01 ,9.975397e-01 ,9.972623e-01 ,9.969849e-01 ,&
        & 9.967077e-01 ,9.964305e-01 ,9.961535e-01 ,9.958765e-01 ,9.955997e-01 ,&
        & 9.953230e-01 ,9.950464e-01 ,9.947699e-01 ,9.944936e-01 ,9.942174e-01 ,&
        & 9.939414e-01 ,9.936656e-01 ,9.933899e-01 ,9.931144e-01 ,9.928390e-01 ,&
        & 9.925639e-01 ,9.922889e-01 ,9.920141e-01 ,9.917396e-01 ,9.914652e-01 ,&
        & 9.911911e-01 ,9.909171e-01 ,9.906434e-01 ,9.903700e-01 ,9.900967e-01 ,&
        & 9.898237e-01 ,9.895510e-01 ,9.892784e-01 ,9.890062e-01 ,9.887342e-01 ,&
        & 9.884625e-01 ,9.881911e-01 ,9.879199e-01 ,9.876490e-01 ,9.873784e-01 ,&
        & 9.871081e-01  /)
      ssaice3(:, 23) = (/ &
! band 23
        & 9.999343e-01 ,9.998917e-01 ,9.998492e-01 ,9.998067e-01 ,9.997642e-01 ,&
        & 9.997218e-01 ,9.996795e-01 ,9.996372e-01 ,9.995949e-01 ,9.995528e-01 ,&
        & 9.995106e-01 ,9.994686e-01 ,9.994265e-01 ,9.993845e-01 ,9.993426e-01 ,&
        & 9.993007e-01 ,9.992589e-01 ,9.992171e-01 ,9.991754e-01 ,9.991337e-01 ,&
        & 9.990921e-01 ,9.990505e-01 ,9.990089e-01 ,9.989674e-01 ,9.989260e-01 ,&
        & 9.988846e-01 ,9.988432e-01 ,9.988019e-01 ,9.987606e-01 ,9.987194e-01 ,&
        & 9.986782e-01 ,9.986370e-01 ,9.985959e-01 ,9.985549e-01 ,9.985139e-01 ,&
        & 9.984729e-01 ,9.984319e-01 ,9.983910e-01 ,9.983502e-01 ,9.983094e-01 ,&
        & 9.982686e-01 ,9.982279e-01 ,9.981872e-01 ,9.981465e-01 ,9.981059e-01 ,&
        & 9.980653e-01  /)
      ssaice3(:, 24) = (/ &
! band 24
        & 9.999978e-01 ,9.999965e-01 ,9.999952e-01 ,9.999939e-01 ,9.999926e-01 ,&
        & 9.999913e-01 ,9.999900e-01 ,9.999887e-01 ,9.999873e-01 ,9.999860e-01 ,&
        & 9.999847e-01 ,9.999834e-01 ,9.999821e-01 ,9.999808e-01 ,9.999795e-01 ,&
        & 9.999782e-01 ,9.999769e-01 ,9.999756e-01 ,9.999743e-01 ,9.999730e-01 ,&
        & 9.999717e-01 ,9.999704e-01 ,9.999691e-01 ,9.999678e-01 ,9.999665e-01 ,&
        & 9.999652e-01 ,9.999639e-01 ,9.999626e-01 ,9.999613e-01 ,9.999600e-01 ,&
        & 9.999587e-01 ,9.999574e-01 ,9.999561e-01 ,9.999548e-01 ,9.999535e-01 ,&
        & 9.999522e-01 ,9.999509e-01 ,9.999496e-01 ,9.999483e-01 ,9.999470e-01 ,&
        & 9.999457e-01 ,9.999444e-01 ,9.999431e-01 ,9.999418e-01 ,9.999405e-01 ,&
        & 9.999392e-01  /)
      ssaice3(:, 25) = (/ &
! band 25
        & 9.999994e-01 ,9.999993e-01 ,9.999991e-01 ,9.999990e-01 ,9.999989e-01 ,&
        & 9.999987e-01 ,9.999986e-01 ,9.999984e-01 ,9.999983e-01 ,9.999982e-01 ,&
        & 9.999980e-01 ,9.999979e-01 ,9.999977e-01 ,9.999976e-01 ,9.999975e-01 ,&
        & 9.999973e-01 ,9.999972e-01 ,9.999970e-01 ,9.999969e-01 ,9.999967e-01 ,&
        & 9.999966e-01 ,9.999965e-01 ,9.999963e-01 ,9.999962e-01 ,9.999960e-01 ,&
        & 9.999959e-01 ,9.999957e-01 ,9.999956e-01 ,9.999954e-01 ,9.999953e-01 ,&
        & 9.999952e-01 ,9.999950e-01 ,9.999949e-01 ,9.999947e-01 ,9.999946e-01 ,&
        & 9.999944e-01 ,9.999943e-01 ,9.999941e-01 ,9.999940e-01 ,9.999939e-01 ,&
        & 9.999937e-01 ,9.999936e-01 ,9.999934e-01 ,9.999933e-01 ,9.999931e-01 ,&
        & 9.999930e-01  /)
      ssaice3(:, 26) = (/ &
! band 26
        & 9.999997e-01 ,9.999995e-01 ,9.999992e-01 ,9.999990e-01 ,9.999987e-01 ,&
        & 9.999985e-01 ,9.999983e-01 ,9.999980e-01 ,9.999978e-01 ,9.999976e-01 ,&
        & 9.999973e-01 ,9.999971e-01 ,9.999969e-01 ,9.999967e-01 ,9.999965e-01 ,&
        & 9.999963e-01 ,9.999960e-01 ,9.999958e-01 ,9.999956e-01 ,9.999954e-01 ,&
        & 9.999952e-01 ,9.999950e-01 ,9.999948e-01 ,9.999946e-01 ,9.999944e-01 ,&
        & 9.999942e-01 ,9.999939e-01 ,9.999937e-01 ,9.999935e-01 ,9.999933e-01 ,&
        & 9.999931e-01 ,9.999929e-01 ,9.999927e-01 ,9.999925e-01 ,9.999923e-01 ,&
        & 9.999920e-01 ,9.999918e-01 ,9.999916e-01 ,9.999914e-01 ,9.999911e-01 ,&
        & 9.999909e-01 ,9.999907e-01 ,9.999905e-01 ,9.999902e-01 ,9.999900e-01 ,&
        & 9.999897e-01  /)
      ssaice3(:, 27) = (/ &
! band 27
        & 9.999991e-01 ,9.999985e-01 ,9.999980e-01 ,9.999974e-01 ,9.999968e-01 ,&
        & 9.999963e-01 ,9.999957e-01 ,9.999951e-01 ,9.999946e-01 ,9.999940e-01 ,&
        & 9.999934e-01 ,9.999929e-01 ,9.999923e-01 ,9.999918e-01 ,9.999912e-01 ,&
        & 9.999907e-01 ,9.999901e-01 ,9.999896e-01 ,9.999891e-01 ,9.999885e-01 ,&
        & 9.999880e-01 ,9.999874e-01 ,9.999869e-01 ,9.999863e-01 ,9.999858e-01 ,&
        & 9.999853e-01 ,9.999847e-01 ,9.999842e-01 ,9.999836e-01 ,9.999831e-01 ,&
        & 9.999826e-01 ,9.999820e-01 ,9.999815e-01 ,9.999809e-01 ,9.999804e-01 ,&
        & 9.999798e-01 ,9.999793e-01 ,9.999787e-01 ,9.999782e-01 ,9.999776e-01 ,&
        & 9.999770e-01 ,9.999765e-01 ,9.999759e-01 ,9.999754e-01 ,9.999748e-01 ,&
        & 9.999742e-01  /)
      ssaice3(:, 28) = (/ &
! band 28
        & 9.999975e-01 ,9.999961e-01 ,9.999946e-01 ,9.999931e-01 ,9.999917e-01 ,&
        & 9.999903e-01 ,9.999888e-01 ,9.999874e-01 ,9.999859e-01 ,9.999845e-01 ,&
        & 9.999831e-01 ,9.999816e-01 ,9.999802e-01 ,9.999788e-01 ,9.999774e-01 ,&
        & 9.999759e-01 ,9.999745e-01 ,9.999731e-01 ,9.999717e-01 ,9.999702e-01 ,&
        & 9.999688e-01 ,9.999674e-01 ,9.999660e-01 ,9.999646e-01 ,9.999631e-01 ,&
        & 9.999617e-01 ,9.999603e-01 ,9.999589e-01 ,9.999574e-01 ,9.999560e-01 ,&
        & 9.999546e-01 ,9.999532e-01 ,9.999517e-01 ,9.999503e-01 ,9.999489e-01 ,&
        & 9.999474e-01 ,9.999460e-01 ,9.999446e-01 ,9.999431e-01 ,9.999417e-01 ,&
        & 9.999403e-01 ,9.999388e-01 ,9.999374e-01 ,9.999359e-01 ,9.999345e-01 ,&
        & 9.999330e-01  /)
      ssaice3(:, 29) = (/ &
! band 29
        & 4.526500e-01 ,5.287890e-01 ,5.410487e-01 ,5.459865e-01 ,5.485149e-01 ,&
        & 5.498914e-01 ,5.505895e-01 ,5.508310e-01 ,5.507364e-01 ,5.503793e-01 ,&
        & 5.498090e-01 ,5.490612e-01 ,5.481637e-01 ,5.471395e-01 ,5.460083e-01 ,&
        & 5.447878e-01 ,5.434946e-01 ,5.421442e-01 ,5.407514e-01 ,5.393309e-01 ,&
        & 5.378970e-01 ,5.364641e-01 ,5.350464e-01 ,5.336582e-01 ,5.323140e-01 ,&
        & 5.310283e-01 ,5.298158e-01 ,5.286914e-01 ,5.276704e-01 ,5.267680e-01 ,&
        & 5.260000e-01 ,5.253823e-01 ,5.249311e-01 ,5.246629e-01 ,5.245946e-01 ,&
        & 5.247434e-01 ,5.251268e-01 ,5.257626e-01 ,5.266693e-01 ,5.278653e-01 ,&
        & 5.293698e-01 ,5.312022e-01 ,5.333823e-01 ,5.359305e-01 ,5.388676e-01 ,&
        & 5.422146e-01  /)

! asymmetry factor: unitless
      asyice3(:, 16) = (/ &
! band 16
        & 8.340752e-01 ,8.435170e-01 ,8.517487e-01 ,8.592064e-01 ,8.660387e-01 ,&
        & 8.723204e-01 ,8.780997e-01 ,8.834137e-01 ,8.882934e-01 ,8.927662e-01 ,&
        & 8.968577e-01 ,9.005914e-01 ,9.039899e-01 ,9.070745e-01 ,9.098659e-01 ,&
        & 9.123836e-01 ,9.146466e-01 ,9.166734e-01 ,9.184817e-01 ,9.200886e-01 ,&
        & 9.215109e-01 ,9.227648e-01 ,9.238661e-01 ,9.248304e-01 ,9.256727e-01 ,&
        & 9.264078e-01 ,9.270505e-01 ,9.276150e-01 ,9.281156e-01 ,9.285662e-01 ,&
        & 9.289806e-01 ,9.293726e-01 ,9.297557e-01 ,9.301435e-01 ,9.305491e-01 ,&
        & 9.309859e-01 ,9.314671e-01 ,9.320055e-01 ,9.326140e-01 ,9.333053e-01 ,&
        & 9.340919e-01 ,9.349861e-01 ,9.360000e-01 ,9.371451e-01 ,9.384329e-01 ,&
        & 9.398744e-01  /)
      asyice3(:, 17) = (/ &
! band 17
        & 8.728160e-01 ,8.777333e-01 ,8.823754e-01 ,8.867535e-01 ,8.908785e-01 ,&
        & 8.947611e-01 ,8.984118e-01 ,9.018408e-01 ,9.050582e-01 ,9.080739e-01 ,&
        & 9.108976e-01 ,9.135388e-01 ,9.160068e-01 ,9.183106e-01 ,9.204595e-01 ,&
        & 9.224620e-01 ,9.243271e-01 ,9.260632e-01 ,9.276788e-01 ,9.291822e-01 ,&
        & 9.305817e-01 ,9.318853e-01 ,9.331012e-01 ,9.342372e-01 ,9.353013e-01 ,&
        & 9.363013e-01 ,9.372450e-01 ,9.381400e-01 ,9.389939e-01 ,9.398145e-01 ,&
        & 9.406092e-01 ,9.413856e-01 ,9.421511e-01 ,9.429131e-01 ,9.436790e-01 ,&
        & 9.444561e-01 ,9.452517e-01 ,9.460729e-01 ,9.469270e-01 ,9.478209e-01 ,&
        & 9.487617e-01 ,9.497562e-01 ,9.508112e-01 ,9.519335e-01 ,9.531294e-01 ,&
        & 9.544055e-01  /)
      asyice3(:, 18) = (/ &
! band 18
        & 7.897566e-01 ,7.948704e-01 ,7.998041e-01 ,8.045623e-01 ,8.091495e-01 ,&
        & 8.135702e-01 ,8.178290e-01 ,8.219305e-01 ,8.258790e-01 ,8.296792e-01 ,&
        & 8.333355e-01 ,8.368524e-01 ,8.402343e-01 ,8.434856e-01 ,8.466108e-01 ,&
        & 8.496143e-01 ,8.525004e-01 ,8.552737e-01 ,8.579384e-01 ,8.604990e-01 ,&
        & 8.629597e-01 ,8.653250e-01 ,8.675992e-01 ,8.697867e-01 ,8.718916e-01 ,&
        & 8.739185e-01 ,8.758715e-01 ,8.777551e-01 ,8.795734e-01 ,8.813308e-01 ,&
        & 8.830315e-01 ,8.846799e-01 ,8.862802e-01 ,8.878366e-01 ,8.893534e-01 ,&
        & 8.908350e-01 ,8.922854e-01 ,8.937090e-01 ,8.951099e-01 ,8.964925e-01 ,&
        & 8.978609e-01 ,8.992192e-01 ,9.005718e-01 ,9.019229e-01 ,9.032765e-01 ,&
        & 9.046369e-01  /)
      asyice3(:, 19) = (/ &
! band 19
        & 7.812615e-01 ,7.887764e-01 ,7.959664e-01 ,8.028413e-01 ,8.094109e-01 ,&
        & 8.156849e-01 ,8.216730e-01 ,8.273846e-01 ,8.328294e-01 ,8.380166e-01 ,&
        & 8.429556e-01 ,8.476556e-01 ,8.521258e-01 ,8.563753e-01 ,8.604131e-01 ,&
        & 8.642481e-01 ,8.678893e-01 ,8.713455e-01 ,8.746254e-01 ,8.777378e-01 ,&
        & 8.806914e-01 ,8.834948e-01 ,8.861566e-01 ,8.886854e-01 ,8.910897e-01 ,&
        & 8.933779e-01 ,8.955586e-01 ,8.976402e-01 ,8.996311e-01 ,9.015398e-01 ,&
        & 9.033745e-01 ,9.051436e-01 ,9.068555e-01 ,9.085185e-01 ,9.101410e-01 ,&
        & 9.117311e-01 ,9.132972e-01 ,9.148476e-01 ,9.163905e-01 ,9.179340e-01 ,&
        & 9.194864e-01 ,9.210559e-01 ,9.226505e-01 ,9.242784e-01 ,9.259476e-01 ,&
        & 9.276661e-01  /)
      asyice3(:, 20) = (/ &
! band 20
        & 7.640720e-01 ,7.691119e-01 ,7.739941e-01 ,7.787222e-01 ,7.832998e-01 ,&
        & 7.877304e-01 ,7.920177e-01 ,7.961652e-01 ,8.001765e-01 ,8.040551e-01 ,&
        & 8.078044e-01 ,8.114280e-01 ,8.149294e-01 ,8.183119e-01 ,8.215791e-01 ,&
        & 8.247344e-01 ,8.277812e-01 ,8.307229e-01 ,8.335629e-01 ,8.363046e-01 ,&
        & 8.389514e-01 ,8.415067e-01 ,8.439738e-01 ,8.463560e-01 ,8.486568e-01 ,&
        & 8.508795e-01 ,8.530274e-01 ,8.551039e-01 ,8.571122e-01 ,8.590558e-01 ,&
        & 8.609378e-01 ,8.627618e-01 ,8.645309e-01 ,8.662485e-01 ,8.679178e-01 ,&
        & 8.695423e-01 ,8.711251e-01 ,8.726697e-01 ,8.741792e-01 ,8.756571e-01 ,&
        & 8.771065e-01 ,8.785307e-01 ,8.799331e-01 ,8.813169e-01 ,8.826854e-01 ,&
        & 8.840419e-01  /)
      asyice3(:, 21) = (/ &
! band 21
        & 7.602598e-01 ,7.651572e-01 ,7.699014e-01 ,7.744962e-01 ,7.789452e-01 ,&
        & 7.832522e-01 ,7.874205e-01 ,7.914538e-01 ,7.953555e-01 ,7.991290e-01 ,&
        & 8.027777e-01 ,8.063049e-01 ,8.097140e-01 ,8.130081e-01 ,8.161906e-01 ,&
        & 8.192645e-01 ,8.222331e-01 ,8.250993e-01 ,8.278664e-01 ,8.305374e-01 ,&
        & 8.331153e-01 ,8.356030e-01 ,8.380037e-01 ,8.403201e-01 ,8.425553e-01 ,&
        & 8.447121e-01 ,8.467935e-01 ,8.488022e-01 ,8.507412e-01 ,8.526132e-01 ,&
        & 8.544210e-01 ,8.561675e-01 ,8.578554e-01 ,8.594875e-01 ,8.610665e-01 ,&
        & 8.625951e-01 ,8.640760e-01 ,8.655119e-01 ,8.669055e-01 ,8.682594e-01 ,&
        & 8.695763e-01 ,8.708587e-01 ,8.721094e-01 ,8.733308e-01 ,8.745255e-01 ,&
        & 8.756961e-01  /)
      asyice3(:, 22) = (/ &
! band 22
        & 7.568957e-01 ,7.606995e-01 ,7.644072e-01 ,7.680204e-01 ,7.715402e-01 ,&
        & 7.749682e-01 ,7.783057e-01 ,7.815541e-01 ,7.847148e-01 ,7.877892e-01 ,&
        & 7.907786e-01 ,7.936846e-01 ,7.965084e-01 ,7.992515e-01 ,8.019153e-01 ,&
        & 8.045011e-01 ,8.070103e-01 ,8.094444e-01 ,8.118048e-01 ,8.140927e-01 ,&
        & 8.163097e-01 ,8.184571e-01 ,8.205364e-01 ,8.225488e-01 ,8.244958e-01 ,&
        & 8.263789e-01 ,8.281993e-01 ,8.299586e-01 ,8.316580e-01 ,8.332991e-01 ,&
        & 8.348831e-01 ,8.364115e-01 ,8.378857e-01 ,8.393071e-01 ,8.406770e-01 ,&
        & 8.419969e-01 ,8.432682e-01 ,8.444923e-01 ,8.456706e-01 ,8.468044e-01 ,&
        & 8.478952e-01 ,8.489444e-01 ,8.499533e-01 ,8.509234e-01 ,8.518561e-01 ,&
        & 8.527528e-01  /)
      asyice3(:, 23) = (/ &
! band 23
        & 7.575066e-01 ,7.606912e-01 ,7.638236e-01 ,7.669035e-01 ,7.699306e-01 ,&
        & 7.729046e-01 ,7.758254e-01 ,7.786926e-01 ,7.815060e-01 ,7.842654e-01 ,&
        & 7.869705e-01 ,7.896211e-01 ,7.922168e-01 ,7.947574e-01 ,7.972428e-01 ,&
        & 7.996726e-01 ,8.020466e-01 ,8.043646e-01 ,8.066262e-01 ,8.088313e-01 ,&
        & 8.109796e-01 ,8.130709e-01 ,8.151049e-01 ,8.170814e-01 ,8.190001e-01 ,&
        & 8.208608e-01 ,8.226632e-01 ,8.244071e-01 ,8.260924e-01 ,8.277186e-01 ,&
        & 8.292856e-01 ,8.307932e-01 ,8.322411e-01 ,8.336291e-01 ,8.349570e-01 ,&
        & 8.362244e-01 ,8.374312e-01 ,8.385772e-01 ,8.396621e-01 ,8.406856e-01 ,&
        & 8.416476e-01 ,8.425479e-01 ,8.433861e-01 ,8.441620e-01 ,8.448755e-01 ,&
        & 8.455263e-01  /)
      asyice3(:, 24) = (/ &
! band 24
        & 7.568829e-01 ,7.597947e-01 ,7.626745e-01 ,7.655212e-01 ,7.683337e-01 ,&
        & 7.711111e-01 ,7.738523e-01 ,7.765565e-01 ,7.792225e-01 ,7.818494e-01 ,&
        & 7.844362e-01 ,7.869819e-01 ,7.894854e-01 ,7.919459e-01 ,7.943623e-01 ,&
        & 7.967337e-01 ,7.990590e-01 ,8.013373e-01 ,8.035676e-01 ,8.057488e-01 ,&
        & 8.078802e-01 ,8.099605e-01 ,8.119890e-01 ,8.139645e-01 ,8.158862e-01 ,&
        & 8.177530e-01 ,8.195641e-01 ,8.213183e-01 ,8.230149e-01 ,8.246527e-01 ,&
        & 8.262308e-01 ,8.277483e-01 ,8.292042e-01 ,8.305976e-01 ,8.319275e-01 ,&
        & 8.331929e-01 ,8.343929e-01 ,8.355265e-01 ,8.365928e-01 ,8.375909e-01 ,&
        & 8.385197e-01 ,8.393784e-01 ,8.401659e-01 ,8.408815e-01 ,8.415240e-01 ,&
        & 8.420926e-01  /)
      asyice3(:, 25) = (/ &
! band 25
        & 7.548616e-01 ,7.575454e-01 ,7.602153e-01 ,7.628696e-01 ,7.655067e-01 ,&
        & 7.681249e-01 ,7.707225e-01 ,7.732978e-01 ,7.758492e-01 ,7.783750e-01 ,&
        & 7.808735e-01 ,7.833430e-01 ,7.857819e-01 ,7.881886e-01 ,7.905612e-01 ,&
        & 7.928983e-01 ,7.951980e-01 ,7.974588e-01 ,7.996789e-01 ,8.018567e-01 ,&
        & 8.039905e-01 ,8.060787e-01 ,8.081196e-01 ,8.101115e-01 ,8.120527e-01 ,&
        & 8.139416e-01 ,8.157764e-01 ,8.175557e-01 ,8.192776e-01 ,8.209405e-01 ,&
        & 8.225427e-01 ,8.240826e-01 ,8.255585e-01 ,8.269688e-01 ,8.283117e-01 ,&
        & 8.295856e-01 ,8.307889e-01 ,8.319198e-01 ,8.329767e-01 ,8.339579e-01 ,&
        & 8.348619e-01 ,8.356868e-01 ,8.364311e-01 ,8.370930e-01 ,8.376710e-01 ,&
        & 8.381633e-01  /)
      asyice3(:, 26) = (/ &
! band 26
        & 7.491854e-01 ,7.518523e-01 ,7.545089e-01 ,7.571534e-01 ,7.597839e-01 ,&
        & 7.623987e-01 ,7.649959e-01 ,7.675737e-01 ,7.701303e-01 ,7.726639e-01 ,&
        & 7.751727e-01 ,7.776548e-01 ,7.801084e-01 ,7.825318e-01 ,7.849230e-01 ,&
        & 7.872804e-01 ,7.896020e-01 ,7.918862e-01 ,7.941309e-01 ,7.963345e-01 ,&
        & 7.984951e-01 ,8.006109e-01 ,8.026802e-01 ,8.047009e-01 ,8.066715e-01 ,&
        & 8.085900e-01 ,8.104546e-01 ,8.122636e-01 ,8.140150e-01 ,8.157072e-01 ,&
        & 8.173382e-01 ,8.189063e-01 ,8.204096e-01 ,8.218464e-01 ,8.232148e-01 ,&
        & 8.245130e-01 ,8.257391e-01 ,8.268915e-01 ,8.279682e-01 ,8.289675e-01 ,&
        & 8.298875e-01 ,8.307264e-01 ,8.314824e-01 ,8.321537e-01 ,8.327385e-01 ,&
        & 8.332350e-01  /)
      asyice3(:, 27) = (/ &
! band 27
        & 7.397086e-01 ,7.424069e-01 ,7.450955e-01 ,7.477725e-01 ,7.504362e-01 ,&
        & 7.530846e-01 ,7.557159e-01 ,7.583283e-01 ,7.609199e-01 ,7.634888e-01 ,&
        & 7.660332e-01 ,7.685512e-01 ,7.710411e-01 ,7.735009e-01 ,7.759288e-01 ,&
        & 7.783229e-01 ,7.806814e-01 ,7.830024e-01 ,7.852841e-01 ,7.875246e-01 ,&
        & 7.897221e-01 ,7.918748e-01 ,7.939807e-01 ,7.960380e-01 ,7.980449e-01 ,&
        & 7.999995e-01 ,8.019000e-01 ,8.037445e-01 ,8.055311e-01 ,8.072581e-01 ,&
        & 8.089235e-01 ,8.105255e-01 ,8.120623e-01 ,8.135319e-01 ,8.149326e-01 ,&
        & 8.162626e-01 ,8.175198e-01 ,8.187025e-01 ,8.198089e-01 ,8.208371e-01 ,&
        & 8.217852e-01 ,8.226514e-01 ,8.234338e-01 ,8.241306e-01 ,8.247399e-01 ,&
        & 8.252599e-01  /)
      asyice3(:, 28) = (/ &
! band 28
        & 7.224533e-01 ,7.251681e-01 ,7.278728e-01 ,7.305654e-01 ,7.332444e-01 ,&
        & 7.359078e-01 ,7.385539e-01 ,7.411808e-01 ,7.437869e-01 ,7.463702e-01 ,&
        & 7.489291e-01 ,7.514616e-01 ,7.539661e-01 ,7.564408e-01 ,7.588837e-01 ,&
        & 7.612933e-01 ,7.636676e-01 ,7.660049e-01 ,7.683034e-01 ,7.705612e-01 ,&
        & 7.727767e-01 ,7.749480e-01 ,7.770733e-01 ,7.791509e-01 ,7.811789e-01 ,&
        & 7.831556e-01 ,7.850791e-01 ,7.869478e-01 ,7.887597e-01 ,7.905131e-01 ,&
        & 7.922062e-01 ,7.938372e-01 ,7.954044e-01 ,7.969059e-01 ,7.983399e-01 ,&
        & 7.997047e-01 ,8.009985e-01 ,8.022195e-01 ,8.033658e-01 ,8.044357e-01 ,&
        & 8.054275e-01 ,8.063392e-01 ,8.071692e-01 ,8.079157e-01 ,8.085768e-01 ,&
        & 8.091507e-01  /)
      asyice3(:, 29) = (/ &
! band 29
        & 8.850026e-01 ,9.005489e-01 ,9.069242e-01 ,9.121799e-01 ,9.168987e-01 ,&
        & 9.212259e-01 ,9.252176e-01 ,9.289028e-01 ,9.323000e-01 ,9.354235e-01 ,&
        & 9.382858e-01 ,9.408985e-01 ,9.432734e-01 ,9.454218e-01 ,9.473557e-01 ,&
        & 9.490871e-01 ,9.506282e-01 ,9.519917e-01 ,9.531904e-01 ,9.542374e-01 ,&
        & 9.551461e-01 ,9.559298e-01 ,9.566023e-01 ,9.571775e-01 ,9.576692e-01 ,&
        & 9.580916e-01 ,9.584589e-01 ,9.587853e-01 ,9.590851e-01 ,9.593729e-01 ,&
        & 9.596632e-01 ,9.599705e-01 ,9.603096e-01 ,9.606954e-01 ,9.611427e-01 ,&
        & 9.616667e-01 ,9.622826e-01 ,9.630060e-01 ,9.638524e-01 ,9.648379e-01 ,&
        & 9.659788e-01 ,9.672916e-01 ,9.687933e-01 ,9.705014e-01 ,9.724337e-01 ,&
        & 9.746084e-01  /)

! fdelta: unitless
      fdlice3(:, 16) = (/ &
! band 16
        & 4.959277e-02 ,4.685292e-02 ,4.426104e-02 ,4.181231e-02 ,3.950191e-02 ,&
        & 3.732500e-02 ,3.527675e-02 ,3.335235e-02 ,3.154697e-02 ,2.985578e-02 ,&
        & 2.827395e-02 ,2.679666e-02 ,2.541909e-02 ,2.413640e-02 ,2.294378e-02 ,&
        & 2.183639e-02 ,2.080940e-02 ,1.985801e-02 ,1.897736e-02 ,1.816265e-02 ,&
        & 1.740905e-02 ,1.671172e-02 ,1.606585e-02 ,1.546661e-02 ,1.490917e-02 ,&
        & 1.438870e-02 ,1.390038e-02 ,1.343939e-02 ,1.300089e-02 ,1.258006e-02 ,&
        & 1.217208e-02 ,1.177212e-02 ,1.137536e-02 ,1.097696e-02 ,1.057210e-02 ,&
        & 1.015596e-02 ,9.723704e-03 ,9.270516e-03 ,8.791565e-03 ,8.282026e-03 ,&
        & 7.737072e-03 ,7.151879e-03 ,6.521619e-03 ,5.841467e-03 ,5.106597e-03 ,&
        & 4.312183e-03  /)
      fdlice3(:, 17) = (/ &
! band 17
        & 5.071224e-02 ,5.000217e-02 ,4.933872e-02 ,4.871992e-02 ,4.814380e-02 ,&
        & 4.760839e-02 ,4.711170e-02 ,4.665177e-02 ,4.622662e-02 ,4.583426e-02 ,&
        & 4.547274e-02 ,4.514007e-02 ,4.483428e-02 ,4.455340e-02 ,4.429544e-02 ,&
        & 4.405844e-02 ,4.384041e-02 ,4.363939e-02 ,4.345340e-02 ,4.328047e-02 ,&
        & 4.311861e-02 ,4.296586e-02 ,4.282024e-02 ,4.267977e-02 ,4.254248e-02 ,&
        & 4.240640e-02 ,4.226955e-02 ,4.212995e-02 ,4.198564e-02 ,4.183462e-02 ,&
        & 4.167494e-02 ,4.150462e-02 ,4.132167e-02 ,4.112413e-02 ,4.091003e-02 ,&
        & 4.067737e-02 ,4.042420e-02 ,4.014854e-02 ,3.984840e-02 ,3.952183e-02 ,&
        & 3.916683e-02 ,3.878144e-02 ,3.836368e-02 ,3.791158e-02 ,3.742316e-02 ,&
        & 3.689645e-02  /)
      fdlice3(:, 18) = (/ &
! band 18
        & 1.062938e-01 ,1.065234e-01 ,1.067822e-01 ,1.070682e-01 ,1.073793e-01 ,&
        & 1.077137e-01 ,1.080693e-01 ,1.084442e-01 ,1.088364e-01 ,1.092439e-01 ,&
        & 1.096647e-01 ,1.100970e-01 ,1.105387e-01 ,1.109878e-01 ,1.114423e-01 ,&
        & 1.119004e-01 ,1.123599e-01 ,1.128190e-01 ,1.132757e-01 ,1.137279e-01 ,&
        & 1.141738e-01 ,1.146113e-01 ,1.150385e-01 ,1.154534e-01 ,1.158540e-01 ,&
        & 1.162383e-01 ,1.166045e-01 ,1.169504e-01 ,1.172741e-01 ,1.175738e-01 ,&
        & 1.178472e-01 ,1.180926e-01 ,1.183080e-01 ,1.184913e-01 ,1.186405e-01 ,&
        & 1.187538e-01 ,1.188291e-01 ,1.188645e-01 ,1.188580e-01 ,1.188076e-01 ,&
        & 1.187113e-01 ,1.185672e-01 ,1.183733e-01 ,1.181277e-01 ,1.178282e-01 ,&
        & 1.174731e-01  /)
      fdlice3(:, 19) = (/ &
! band 19
        & 1.076195e-01 ,1.065195e-01 ,1.054696e-01 ,1.044673e-01 ,1.035099e-01 ,&
        & 1.025951e-01 ,1.017203e-01 ,1.008831e-01 ,1.000808e-01 ,9.931116e-02 ,&
        & 9.857151e-02 ,9.785939e-02 ,9.717230e-02 ,9.650774e-02 ,9.586322e-02 ,&
        & 9.523623e-02 ,9.462427e-02 ,9.402484e-02 ,9.343544e-02 ,9.285358e-02 ,&
        & 9.227675e-02 ,9.170245e-02 ,9.112818e-02 ,9.055144e-02 ,8.996974e-02 ,&
        & 8.938056e-02 ,8.878142e-02 ,8.816981e-02 ,8.754323e-02 ,8.689919e-02 ,&
        & 8.623517e-02 ,8.554869e-02 ,8.483724e-02 ,8.409832e-02 ,8.332943e-02 ,&
        & 8.252807e-02 ,8.169175e-02 ,8.081795e-02 ,7.990419e-02 ,7.894796e-02 ,&
        & 7.794676e-02 ,7.689809e-02 ,7.579945e-02 ,7.464834e-02 ,7.344227e-02 ,&
        & 7.217872e-02  /)
      fdlice3(:, 20) = (/ &
! band 20
        & 1.119014e-01 ,1.122706e-01 ,1.126690e-01 ,1.130947e-01 ,1.135456e-01 ,&
        & 1.140199e-01 ,1.145154e-01 ,1.150302e-01 ,1.155623e-01 ,1.161096e-01 ,&
        & 1.166703e-01 ,1.172422e-01 ,1.178233e-01 ,1.184118e-01 ,1.190055e-01 ,&
        & 1.196025e-01 ,1.202008e-01 ,1.207983e-01 ,1.213931e-01 ,1.219832e-01 ,&
        & 1.225665e-01 ,1.231411e-01 ,1.237050e-01 ,1.242561e-01 ,1.247926e-01 ,&
        & 1.253122e-01 ,1.258132e-01 ,1.262934e-01 ,1.267509e-01 ,1.271836e-01 ,&
        & 1.275896e-01 ,1.279669e-01 ,1.283134e-01 ,1.286272e-01 ,1.289063e-01 ,&
        & 1.291486e-01 ,1.293522e-01 ,1.295150e-01 ,1.296351e-01 ,1.297104e-01 ,&
        & 1.297390e-01 ,1.297189e-01 ,1.296480e-01 ,1.295244e-01 ,1.293460e-01 ,&
        & 1.291109e-01  /)
      fdlice3(:, 21) = (/ &
! band 21
        & 1.133298e-01 ,1.136777e-01 ,1.140556e-01 ,1.144615e-01 ,1.148934e-01 ,&
        & 1.153492e-01 ,1.158269e-01 ,1.163243e-01 ,1.168396e-01 ,1.173706e-01 ,&
        & 1.179152e-01 ,1.184715e-01 ,1.190374e-01 ,1.196108e-01 ,1.201897e-01 ,&
        & 1.207720e-01 ,1.213558e-01 ,1.219389e-01 ,1.225194e-01 ,1.230951e-01 ,&
        & 1.236640e-01 ,1.242241e-01 ,1.247733e-01 ,1.253096e-01 ,1.258309e-01 ,&
        & 1.263352e-01 ,1.268205e-01 ,1.272847e-01 ,1.277257e-01 ,1.281415e-01 ,&
        & 1.285300e-01 ,1.288893e-01 ,1.292173e-01 ,1.295118e-01 ,1.297710e-01 ,&
        & 1.299927e-01 ,1.301748e-01 ,1.303154e-01 ,1.304124e-01 ,1.304637e-01 ,&
        & 1.304673e-01 ,1.304212e-01 ,1.303233e-01 ,1.301715e-01 ,1.299638e-01 ,&
        & 1.296983e-01  /)
      fdlice3(:, 22) = (/ &
! band 22
        & 1.145360e-01 ,1.153256e-01 ,1.161453e-01 ,1.169929e-01 ,1.178666e-01 ,&
        & 1.187641e-01 ,1.196835e-01 ,1.206227e-01 ,1.215796e-01 ,1.225522e-01 ,&
        & 1.235383e-01 ,1.245361e-01 ,1.255433e-01 ,1.265579e-01 ,1.275779e-01 ,&
        & 1.286011e-01 ,1.296257e-01 ,1.306494e-01 ,1.316703e-01 ,1.326862e-01 ,&
        & 1.336951e-01 ,1.346950e-01 ,1.356838e-01 ,1.366594e-01 ,1.376198e-01 ,&
        & 1.385629e-01 ,1.394866e-01 ,1.403889e-01 ,1.412678e-01 ,1.421212e-01 ,&
        & 1.429469e-01 ,1.437430e-01 ,1.445074e-01 ,1.452381e-01 ,1.459329e-01 ,&
        & 1.465899e-01 ,1.472069e-01 ,1.477819e-01 ,1.483128e-01 ,1.487976e-01 ,&
        & 1.492343e-01 ,1.496207e-01 ,1.499548e-01 ,1.502346e-01 ,1.504579e-01 ,&
        & 1.506227e-01  /)
      fdlice3(:, 23) = (/ &
! band 23
        & 1.153263e-01 ,1.161445e-01 ,1.169932e-01 ,1.178703e-01 ,1.187738e-01 ,&
        & 1.197016e-01 ,1.206516e-01 ,1.216217e-01 ,1.226099e-01 ,1.236141e-01 ,&
        & 1.246322e-01 ,1.256621e-01 ,1.267017e-01 ,1.277491e-01 ,1.288020e-01 ,&
        & 1.298584e-01 ,1.309163e-01 ,1.319736e-01 ,1.330281e-01 ,1.340778e-01 ,&
        & 1.351207e-01 ,1.361546e-01 ,1.371775e-01 ,1.381873e-01 ,1.391820e-01 ,&
        & 1.401593e-01 ,1.411174e-01 ,1.420540e-01 ,1.429671e-01 ,1.438547e-01 ,&
        & 1.447146e-01 ,1.455449e-01 ,1.463433e-01 ,1.471078e-01 ,1.478364e-01 ,&
        & 1.485270e-01 ,1.491774e-01 ,1.497857e-01 ,1.503497e-01 ,1.508674e-01 ,&
        & 1.513367e-01 ,1.517554e-01 ,1.521216e-01 ,1.524332e-01 ,1.526880e-01 ,&
        & 1.528840e-01  /)
      fdlice3(:, 24) = (/ &
! band 24
        & 1.160842e-01 ,1.169118e-01 ,1.177697e-01 ,1.186556e-01 ,1.195676e-01 ,&
        & 1.205036e-01 ,1.214616e-01 ,1.224394e-01 ,1.234349e-01 ,1.244463e-01 ,&
        & 1.254712e-01 ,1.265078e-01 ,1.275539e-01 ,1.286075e-01 ,1.296664e-01 ,&
        & 1.307287e-01 ,1.317923e-01 ,1.328550e-01 ,1.339149e-01 ,1.349699e-01 ,&
        & 1.360179e-01 ,1.370567e-01 ,1.380845e-01 ,1.390991e-01 ,1.400984e-01 ,&
        & 1.410803e-01 ,1.420429e-01 ,1.429840e-01 ,1.439016e-01 ,1.447936e-01 ,&
        & 1.456579e-01 ,1.464925e-01 ,1.472953e-01 ,1.480642e-01 ,1.487972e-01 ,&
        & 1.494923e-01 ,1.501472e-01 ,1.507601e-01 ,1.513287e-01 ,1.518511e-01 ,&
        & 1.523252e-01 ,1.527489e-01 ,1.531201e-01 ,1.534368e-01 ,1.536969e-01 ,&
        & 1.538984e-01  /)
      fdlice3(:, 25) = (/ &
! band 25
        & 1.168725e-01 ,1.177088e-01 ,1.185747e-01 ,1.194680e-01 ,1.203867e-01 ,&
        & 1.213288e-01 ,1.222923e-01 ,1.232750e-01 ,1.242750e-01 ,1.252903e-01 ,&
        & 1.263187e-01 ,1.273583e-01 ,1.284069e-01 ,1.294626e-01 ,1.305233e-01 ,&
        & 1.315870e-01 ,1.326517e-01 ,1.337152e-01 ,1.347756e-01 ,1.358308e-01 ,&
        & 1.368788e-01 ,1.379175e-01 ,1.389449e-01 ,1.399590e-01 ,1.409577e-01 ,&
        & 1.419389e-01 ,1.429007e-01 ,1.438410e-01 ,1.447577e-01 ,1.456488e-01 ,&
        & 1.465123e-01 ,1.473461e-01 ,1.481483e-01 ,1.489166e-01 ,1.496492e-01 ,&
        & 1.503439e-01 ,1.509988e-01 ,1.516118e-01 ,1.521808e-01 ,1.527038e-01 ,&
        & 1.531788e-01 ,1.536037e-01 ,1.539764e-01 ,1.542951e-01 ,1.545575e-01 ,&
        & 1.547617e-01  /)
      fdlice3(:, 26) = (/ &
!band 26
        & 1.180509e-01 ,1.189025e-01 ,1.197820e-01 ,1.206875e-01 ,1.216171e-01 ,&
        & 1.225687e-01 ,1.235404e-01 ,1.245303e-01 ,1.255363e-01 ,1.265564e-01 ,&
        & 1.275888e-01 ,1.286313e-01 ,1.296821e-01 ,1.307392e-01 ,1.318006e-01 ,&
        & 1.328643e-01 ,1.339284e-01 ,1.349908e-01 ,1.360497e-01 ,1.371029e-01 ,&
        & 1.381486e-01 ,1.391848e-01 ,1.402095e-01 ,1.412208e-01 ,1.422165e-01 ,&
        & 1.431949e-01 ,1.441539e-01 ,1.450915e-01 ,1.460058e-01 ,1.468947e-01 ,&
        & 1.477564e-01 ,1.485888e-01 ,1.493900e-01 ,1.501580e-01 ,1.508907e-01 ,&
        & 1.515864e-01 ,1.522428e-01 ,1.528582e-01 ,1.534305e-01 ,1.539578e-01 ,&
        & 1.544380e-01 ,1.548692e-01 ,1.552494e-01 ,1.555767e-01 ,1.558490e-01 ,&
        & 1.560645e-01  /)
      fdlice3(:, 27) = (/ &
! band 27
        & 1.200480e-01 ,1.209267e-01 ,1.218304e-01 ,1.227575e-01 ,1.237059e-01 ,&
        & 1.246739e-01 ,1.256595e-01 ,1.266610e-01 ,1.276765e-01 ,1.287041e-01 ,&
        & 1.297420e-01 ,1.307883e-01 ,1.318412e-01 ,1.328988e-01 ,1.339593e-01 ,&
        & 1.350207e-01 ,1.360813e-01 ,1.371393e-01 ,1.381926e-01 ,1.392396e-01 ,&
        & 1.402783e-01 ,1.413069e-01 ,1.423235e-01 ,1.433263e-01 ,1.443134e-01 ,&
        & 1.452830e-01 ,1.462332e-01 ,1.471622e-01 ,1.480681e-01 ,1.489490e-01 ,&
        & 1.498032e-01 ,1.506286e-01 ,1.514236e-01 ,1.521863e-01 ,1.529147e-01 ,&
        & 1.536070e-01 ,1.542614e-01 ,1.548761e-01 ,1.554491e-01 ,1.559787e-01 ,&
        & 1.564629e-01 ,1.568999e-01 ,1.572879e-01 ,1.576249e-01 ,1.579093e-01 ,&
        & 1.581390e-01  /)
      fdlice3(:, 28) = (/ &
! band 28
        & 1.247813e-01 ,1.256496e-01 ,1.265417e-01 ,1.274560e-01 ,1.283905e-01 ,&
        & 1.293436e-01 ,1.303135e-01 ,1.312983e-01 ,1.322964e-01 ,1.333060e-01 ,&
        & 1.343252e-01 ,1.353523e-01 ,1.363855e-01 ,1.374231e-01 ,1.384632e-01 ,&
        & 1.395042e-01 ,1.405441e-01 ,1.415813e-01 ,1.426140e-01 ,1.436404e-01 ,&
        & 1.446587e-01 ,1.456672e-01 ,1.466640e-01 ,1.476475e-01 ,1.486157e-01 ,&
        & 1.495671e-01 ,1.504997e-01 ,1.514117e-01 ,1.523016e-01 ,1.531673e-01 ,&
        & 1.540073e-01 ,1.548197e-01 ,1.556026e-01 ,1.563545e-01 ,1.570734e-01 ,&
        & 1.577576e-01 ,1.584054e-01 ,1.590149e-01 ,1.595843e-01 ,1.601120e-01 ,&
        & 1.605962e-01 ,1.610349e-01 ,1.614266e-01 ,1.617693e-01 ,1.620614e-01 ,&
        & 1.623011e-01  /)
      fdlice3(:, 29) = (/ &
! band 29
        & 1.006055e-01 ,9.549582e-02 ,9.063960e-02 ,8.602900e-02 ,8.165612e-02 ,&
        & 7.751308e-02 ,7.359199e-02 ,6.988496e-02 ,6.638412e-02 ,6.308156e-02 ,&
        & 5.996942e-02 ,5.703979e-02 ,5.428481e-02 ,5.169657e-02 ,4.926719e-02 ,&
        & 4.698880e-02 ,4.485349e-02 ,4.285339e-02 ,4.098061e-02 ,3.922727e-02 ,&
        & 3.758547e-02 ,3.604733e-02 ,3.460497e-02 ,3.325051e-02 ,3.197604e-02 ,&
        & 3.077369e-02 ,2.963558e-02 ,2.855381e-02 ,2.752050e-02 ,2.652776e-02 ,&
        & 2.556772e-02 ,2.463247e-02 ,2.371415e-02 ,2.280485e-02 ,2.189670e-02 ,&
        & 2.098180e-02 ,2.005228e-02 ,1.910024e-02 ,1.811781e-02 ,1.709709e-02 ,&
        & 1.603020e-02 ,1.490925e-02 ,1.372635e-02 ,1.247363e-02 ,1.114319e-02 ,&
        & 9.727157e-03  /)

      end subroutine swcldpr

      end module rrtmg_sw_init_f

      module rrtmg_sw_spcvmc_f

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

      use parrrsw_f, only : nbndsw, ngptsw, mxmol, jpband, mxlay
      use rrsw_tbl_f, only : tblint, bpade, od_lo, exp_tbl
      use rrsw_vsn_f, only : hvrspc, hnamspc
      use rrsw_wvn_f, only : ngc, ngs, ngb
      
      use rrtmg_sw_taumol_f, only: taumol_sw
     
      implicit none

      contains

! ---------------------------------------------------------------------------
      subroutine spcvmc_sw &
            (cc,tncol, ncol, nlayers, istart, iend, icpr, idelm, iout, &
             pavel, tavel, pz, tz, tbound, palbd, palbp, &
             pcldfmc, ptaucmc, pasycmc, pomgcmc, ptaormc, &
             ptaua, pasya, pomga, prmu0, coldry,  adjflux, &
             laytrop, layswtch, laylow, jp, jt, jt1, &
             co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, &
             fac00, fac01, fac10, fac11, &
             selffac, selffrac, indself, forfac, forfrac, indfor, &
             pbbfd, pbbfu, pbbcd, pbbcu, puvfd, puvcd, pnifd, pnicd, &
             pbbfddir, pbbcddir, puvfddir, puvcddir, pnifddir, pnicddir, &
             zgco,zomco,zrdnd,zref,zrefo,zrefd,zrefdo,ztauo,zdbt,ztdbt, &
             ztra,ztrao,ztrad,ztrado,zfd,zfu,ztaug, ztaur, zsflxzen)
! ---------------------------------------------------------------------------
!
! Purpose: Contains spectral loop to compute the shortwave radiative fluxes, 
!          using the two-stream method of H. Barker and McICA, the Monte-Carlo
!          Independent Column Approximation, for the representation of 
!          sub-grid cloud variability (i.e. cloud overlap).
!
! Interface:  *spcvmc_sw* is called from *rrtmg_sw.F90* or rrtmg_sw.1col.F90*
!
! Method:
!    Adapted from two-stream model of H. Barker;
!    Two-stream model options (selected with kmodts in rrtmg_sw_reftra.F90):
!        1: Eddington, 2: PIFM, Zdunkowski et al., 3: discret ordinates
!
! Modifications:
!
! Original: H. Barker
! Revision: Merge with RRTMG_SW: J.-J.Morcrette, ECMWF, Feb 2003
! Revision: Add adjustment for Earth/Sun distance : MJIacono, AER, Oct 2003
! Revision: Bug fix for use of PALBP and PALBD: MJIacono, AER, Nov 2003
! Revision: Bug fix to apply delta scaling to clear sky: AER, Dec 2004
! Revision: Code modified so that delta scaling is not done in cloudy profiles
!           if routine cldprop is used; delta scaling can be applied by swithcing
!           code below if cldprop is not used to get cloud properties. 
!           AER, Jan 2005
! Revision: Modified to use McICA: MJIacono, AER, Nov 2005
! Revision: Uniform formatting for RRTMG: MJIacono, AER, Jul 2006 
! Revision: Use exponential lookup table for transmittance: MJIacono, AER, 
!           Aug 2007 
!
! ------------------------------------------------------------------

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

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

      integer , intent(in) :: tncol, ncol,cc
      integer , intent(in) :: nlayers
      integer , intent(in) :: istart
      integer , intent(in) :: iend
      integer , intent(in) :: icpr
      integer , intent(in) :: idelm   ! delta-m scaling flag
                                              ! [0 = direct and diffuse fluxes are unscaled]
                                              ! [1 = direct and diffuse fluxes are scaled]
      integer , intent(in) :: iout
      integer , intent(in) :: laytrop(:)
      integer , intent(in) :: layswtch(:)
      integer , intent(in) :: laylow(:)

      integer , intent(in) :: indfor(:,:) 
      integer , intent(in) :: indself(:,:) 
      integer , intent(in) :: jp(:,:) 
      integer , intent(in) :: jt(:,:) 
      integer , intent(in) :: jt1(:,:) 
                                                          !   Dimensions: (ncol,nlayers)

      real , intent(in) :: pavel(:,:)                     ! layer pressure (hPa, mb) 
                                                          !   Dimensions: (ncol,nlayers)
      real , intent(in) :: tavel(:,:)                     ! layer temperature (K)
                                                          !   Dimensions: (ncol,nlayers)
      real , intent(in) :: pz(:,0:)                       ! level (interface) pressure (hPa, mb)
                                                          !   Dimensions: (ncol,0:nlayers)
      real , intent(in) :: tz(:,0:)                       ! level temperatures (hPa, mb)
                                                          !   Dimensions: (ncol,0:nlayers)
      real , intent(in) :: tbound(:)                      ! surface temperature (K)
                                                          !   Dimensions: (ncol)
      real , intent(in) :: coldry(:,:)                    ! dry air column density (mol/cm2)
                                                          !   Dimensions: (ncol,nlayers)
      real , intent(in) :: colmol(:,:) 
                                                          !   Dimensions: (ncol,nlayers)
      real , intent(in) :: adjflux(:)                     ! Earth/Sun distance adjustment
                                                          !   Dimensions: (jpband)

      real , intent(in) :: palbd(:,:)                     ! surface albedo (diffuse)
                                                          !   Dimensions: (ncol,nbndsw)
      real , intent(in) :: palbp(:,:)                     ! surface albedo (direct)
                                                          !   Dimensions: (ncol,nbndsw)
      real , intent(in) :: prmu0(:)                       ! cosine of solar zenith angle
                                                          !   Dimensions: (ncol)

      real , intent(in) :: pcldfmc(:,:,:)                 ! cloud fraction [mcica]
      real , intent(in) :: ptaucmc(:,:,:)                 ! cloud optical depth [mcica]
      real , intent(in) :: pasycmc(:,:,:)                 ! cloud asymmetry parameter [mcica]
      real , intent(in) :: pomgcmc(:,:,:)                 ! cloud single scattering albedo [mcica]
      real , intent(in) :: ptaormc(:,:,:)                 ! cloud optical depth, non-delta scaled [mcica]
                                                          !   Dimensions: (ncol,nlayers,ngptsw)
   
      real , intent(in) :: ptaua(:,:,:)                   ! aerosol optical depth
      real , intent(in) :: pasya(:,:,:)                   ! aerosol asymmetry parameter
      real , intent(in) :: pomga(:,:,:)                   ! aerosol single scattering albedo
                                                          !   Dimensions: (ncol,nlayers,nbndsw)
                                                               
      real , intent(in) :: colh2o(:,:) 
      real , intent(in) :: colco2(:,:) 
      real , intent(in) :: colch4(:,:) 
      real , intent(in) :: co2mult(:,:) 
      real , intent(in) :: colo3(:,:) 
      real , intent(in) :: colo2(:,:) 
      real , intent(in) :: coln2o(:,:) 
                                                          !   Dimensions: (ncol,nlayers)

      real , intent(in) :: forfac(:,:) 
      real , intent(in) :: forfrac(:,:) 
      real , intent(in) :: selffac(:,:) 
      real , intent(in) :: selffrac(:,:) 
      real , intent(in) :: fac00(:,:) 
      real , intent(in) :: fac01(:,:) 
      real , intent(in) :: fac10(:,:) 
      real , intent(in) :: fac11(:,:) 
                                                          !   Dimensions: (ncol,nlayers)
                                                               
      real, intent(inout) gpu_device  :: zgco(tncol,ngptsw,nlayers+1), zomco(tncol,ngptsw,nlayers+1)  
      real, intent(inout) gpu_device  :: zrdnd(tncol,ngptsw,nlayers+1) 
      real, intent(inout) gpu_device  :: zref(tncol,ngptsw,nlayers+1)  , zrefo(tncol,ngptsw,nlayers+1)  
      real, intent(inout) gpu_device  :: zrefd(tncol,ngptsw,nlayers+1)  , zrefdo(tncol,ngptsw,nlayers+1)  
      real, intent(inout) gpu_device  :: ztauo(tncol,ngptsw,nlayers)  
      real, intent(inout) gpu_device  :: zdbt(tncol,ngptsw,nlayers+1)  ,ztdbt(tncol,ngptsw,nlayers+1)   
      real, intent(inout) gpu_device  :: ztra(tncol,ngptsw,nlayers+1)  , ztrao(tncol,ngptsw,nlayers+1)  
      real, intent(inout) gpu_device  :: ztrad(tncol,ngptsw,nlayers+1)  , ztrado(tncol,ngptsw,nlayers+1)  
      real, intent(inout) gpu_device  :: zfd(tncol,ngptsw,nlayers+1)  , zfu(tncol,ngptsw,nlayers+1)   
real gpu_device  :: zcd(tncol,ngptsw,nlayers+1)  , zcu(tncol,ngptsw,nlayers+1)   
      real, intent(inout) gpu_device :: ztaur(tncol,nlayers,ngptsw), ztaug(tncol,nlayers,ngptsw) 
      real, intent(inout) gpu_device :: zsflxzen(tncol,ngptsw)
   

! ------- Output -------
                                                               !   All Dimensions: (ncol,nlayers+1)
      real , intent(out) :: pbbcd(:,:) 
      real , intent(out) :: pbbcu(:,:) 
      real , intent(out) :: pbbfd(:,:) 
      real , intent(out) :: pbbfu(:,:) 
      real , intent(out) :: pbbfddir(:,:) 
      real , intent(out) :: pbbcddir(:,:) 

      real , intent(out) :: puvcd(:,:) 
      real , intent(out) :: puvfd(:,:) 
      real , intent(out) :: puvcddir(:,:) 
      real , intent(out) :: puvfddir(:,:) 

      real , intent(out) :: pnicd(:,:) 
      real , intent(out) :: pnifd(:,:) 
      real , intent(out) :: pnicddir(:,:) 
      real , intent(out) :: pnifddir(:,:) 
      
! ------- Local -------
  
      integer   :: klev
      integer  :: ibm, ikl, ikp, ikx
      integer  :: iw, jb, jg, jl, jk

      integer  :: itind

      real  :: tblind, ze1
      real  :: zclear, zcloud
        
      real  :: zincflx, ze2

      real  :: zdbtmc, zdbtmo, zf, zgw, zreflect
      real  :: zwf, tauorig, repclc

      real :: zdbt_nodel(tncol,ngptsw,nlayers+1)
      real :: zdbtc_nodel(tncol,ngptsw,nlayers+1)
      real :: ztdbt_nodel(tncol,ngptsw,nlayers+1)
      real :: ztdbtc_nodel(tncol,ngptsw,nlayers+1)


! Arrays from rrtmg_sw_vrtqdr routine
  
      integer :: iplon

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

!$acc update host(pomga, ptaua)
  
!print *, "aerosol values"
!print *, pomga(1, :, :)
!print *, ptaua(1, :, :)

!$acc kernels     
         pbbcd =0. 
         pbbcu =0. 
         pbbfd =0. 
         pbbfu =0. 
         pbbcddir =0. 
         pbbfddir =0. 
         puvcd =0. 
         puvfd =0. 
         puvcddir =0. 
         puvfddir =0. 
         pnicd =0. 
         pnifd =0. 
         pnicddir =0. 
         pnifddir =0.
         zsflxzen = 0.
!         znirr=0.
!         znirf=0.
!         zparr=0.
!         zparf=0.
!         zuvrr=0.
!         zuvrf=0.
         klev = nlayers
!$acc end kernels      

#ifndef _ACCEL
#  define ncol CHNK
#endif

         
! Calculate the optical depths for gaseous absorption and Rayleigh scattering     
      call taumol_sw(ncol,nlayers, &
                     colh2o , colco2 , colch4 , colo2 , &
                     colo3 , colmol , &
                     laytrop , jp , jt , jt1 , &
                     fac00 , fac01 , fac10 , fac11 , &
                     selffac , selffrac , indself , forfac , forfrac ,&
                     indfor , &
                     zsflxzen , ztaug, ztaur)

      
      repclc = 1.e-12 

#ifdef _ACCEL
# define ILOOP_S_CPU
# define ILOOP_E_CPU
# define ILOOP_S_GPU do iplon = 1, ncol
# define ILOOP_E_GPU enddo
# define WLOOP_S_CPU
# define WLOOP_E_CPU
# define WLOOP_S_GPU do iw = 1, 112
# define WLOOP_E_GPU enddo
#else
# define ILOOP_S_GPU
# define ILOOP_E_GPU
# define ILOOP_S_CPU do iplon = 1, ncol
# define ILOOP_E_CPU enddo
# define WLOOP_S_GPU
# define WLOOP_E_GPU
# define WLOOP_S_CPU do iw = 1, 112
# define WLOOP_E_CPU enddo
#endif

   
!$acc kernels 

      ILOOP_S_GPU
      WLOOP_S_CPU

        WLOOP_S_GPU
        ILOOP_S_CPU

! Top of shortwave spectral band loop, jb = 16 -> 29; ibm = 1 -> 14

          jb = ngb(iw)
          ibm = jb-15
          
! Clear-sky    
!   TOA direct beam    
           
          ztdbtc_nodel(iplon,iw,1)=1.0  !jm
           
! Cloudy-sky    
!   Surface values
          ztrao(iplon,iw,klev+1)   =0.0 
          ztrado(iplon,iw,klev+1)  =0.0 
          zrefo(iplon,iw,klev+1)   =palbp(iplon,ibm) 
          zrefdo(iplon,iw,klev+1)  =palbd(iplon,ibm) 
           
! Total sky    
!   TOA direct beam    
          ztdbt(iplon,iw,1)  =1.0 
          ztdbt_nodel(iplon,iw,1)=1.0

    
!   Surface values
          zdbt(iplon,iw,klev+1)   =0.0 
          ztra(iplon,iw,klev+1)   =0.0 
          ztrad(iplon,iw,klev+1)  =0.0 
          zref(iplon,iw,klev+1)   =palbp(iplon,ibm) 
          zrefd(iplon,iw,klev+1)  =palbd(iplon,ibm) 
    
        enddo
      enddo

!$acc end kernels     


!$acc kernels loop 

       ILOOP_S_GPU
!$acc loop private(zf, zwf, ibm, ikl, jb)
         WLOOP_S_GPU
            !$acc loop seq
            do jk=1,klev

               ikl=klev+1-jk
       WLOOP_S_CPU
               jb = ngb(iw)
               ibm = jb-15
         ILOOP_S_CPU
               ! Clear-sky optical parameters including aerosols
               ztauo(iplon,iw,jk)   = ztaur(iplon,ikl,iw)  + ztaug(iplon,ikl,iw) + ptaua(iplon,ikl,ibm)      

#ifndef _ACCEL
! Use exponential lookup table for transmittance, or expansion of
! exponential for low tau
               zclear = 1.0  - pcldfmc(iplon,ikl,iw)
               zcloud =  pcldfmc(iplon,ikl,iw)

               ze1 = ztauo(iplon,iw,jk) / prmu0(iplon)  ! ztauo corresponds to ztauc at this point in _sw.F version
               if (ze1 .le. od_lo) then
                  zdbtmc = 1. - ze1 + 0.5 * ze1 * ze1
               else
                  tblind = ze1 / (bpade + ze1)
                  itind = tblint * tblind + 0.5
                  zdbtmc = exp_tbl(itind)
               endif

               zdbtc_nodel(iplon,iw,jk) = zdbtmc
               ztdbtc_nodel(iplon,iw,jk+1) = zdbtc_nodel(iplon,iw,jk) * ztdbtc_nodel(iplon,iw,jk)

               tauorig = ztauo(iplon,iw,jk) + ptaormc(iplon,ikl,iw)    ! ztauo corresponds to ztauc at this point in _sw.F version
               ze1 = tauorig / prmu0(iplon)
               if (ze1 .le. od_lo) then
                  zdbtmo = 1. - ze1 + 0.5 * ze1 * ze1
               else
                  tblind = ze1 / (bpade + ze1)
                  itind = tblint * tblind + 0.5
                  zdbtmo = exp_tbl(itind)
               endif

               zdbt_nodel(iplon,iw,jk) = zclear*zdbtmc + zcloud*zdbtmo
               ztdbt_nodel(iplon,iw,jk+1) = zdbt_nodel(iplon,iw,jk) * ztdbt_nodel(iplon,iw,jk)

#endif

               zomco(iplon,iw,jk)   = ztaur(iplon,ikl,iw) + ptaua(iplon,ikl,ibm) * pomga(iplon,ikl,ibm)
               zgco(iplon,iw,jk) = pasya(iplon,ikl,ibm) * pomga(iplon,ikl,ibm) * ptaua(iplon,ikl,ibm) / zomco(iplon,iw,jk)   
               zomco(iplon,iw,jk)   = zomco(iplon,iw,jk) / ztauo(iplon,iw,jk)
               
               zf = zgco(iplon, iw, jk)
               zf = zf * zf
               zwf = zomco(iplon, iw, jk) * zf

               ztauo(iplon, iw, jk) = (1.0 - zwf) * ztauo(iplon, iw, jk)
               zomco(iplon, iw, jk) = (zomco(iplon, iw, jk) - zwf) / (1.0 - zwf)
               zgco(iplon, iw, jk) = (zgco(iplon, iw, jk) - zf) / (1.0 - zf)
               
           end do    
        end do
      end do
!$acc end kernels               


! Clear sky reflectivities
      call reftra_sw (ncol, nlayers, &
                      pcldfmc, zgco, prmu0, ztauo, zomco, &
                      zrefo, zrefdo, ztrao, ztrado, 1)
                        

!$acc kernels loop    
       ILOOP_S_GPU

! Combine clear and cloudy reflectivies and optical depths     

!$acc loop
       WLOOP_S_GPU
            
!$acc loop seq
            do jk=1,klev

       WLOOP_S_CPU
       ILOOP_S_CPU
! Combine clear and cloudy contributions for total sky
               !ikl = klev+1-jk 

! Direct beam transmittance        

               ze1 = (ztauo(iplon,iw,jk))  / prmu0(iplon)      
#ifdef _ACCEL
               zdbtmc = exp(-ze1)
#else
               ze1 = ztauo(iplon,iw,jk) / prmu0(iplon)
               if (ze1 .le. od_lo) then
                  zdbtmc = 1. - ze1 + 0.5 * ze1 * ze1
               else
                  tblind = ze1 / (bpade + ze1)
                  itind = tblint * tblind + 0.5
                  zdbtmc = exp_tbl(itind)
               endif
#endif
               zdbt(iplon,iw,jk)   = zdbtmc
               ztdbt(iplon,iw,jk+1)   = zdbt(iplon,iw,jk)  *ztdbt(iplon,iw,jk)  

           end do          
        end do
      end do
!$acc end kernels

! compute the fluxes from the optical depths and reflectivities

                 
! Vertical quadrature for clear-sky fluxes

!$acc kernels 
       ILOOP_S_GPU
        WLOOP_S_GPU
       WLOOP_S_CPU
          jb = ngb(iw)
          ibm = jb-15
        ILOOP_S_CPU

! Top of shortwave spectral band loop, jb = 16 -> 29; ibm = 1 -> 14


          zgco(iplon,iw,klev+1)   =palbp(iplon,ibm) 
          zomco(iplon,iw,klev+1)  =palbd(iplon,ibm) 
    
        end do
      end do
!$acc end kernels  


            call vrtqdr_sw(ncol, klev, &
                           zrefo  , zrefdo  , ztrao  , ztrado  , &
                           zdbt , zrdnd  , zgco, zomco, ztdbt  , &
                           zcd , zcu  , ztra)
            
! perform band integration for clear cases      
!$acc kernels loop
       ILOOP_S_GPU
    
!$acc loop    
        do ikl=1,klev+1
            
      !$acc loop seq
          do iw = 1, 112
             jb = ngb(iw)
      
             jk=klev+2-ikl
             ibm = jb-15
!DIR$ SIMD
          ILOOP_S_CPU
             zincflx = adjflux(jb)  * zsflxzen(iplon,iw)   * prmu0(iplon)           

! Accumulate spectral fluxes over whole spectrum  
              
             pbbcu(iplon,ikl)  = pbbcu(iplon,ikl)  + zincflx*zcu(iplon,iw,jk)  
             pbbcd(iplon,ikl)  = pbbcd(iplon,ikl)  + zincflx*zcd(iplon,iw,jk)  
             pbbcddir(iplon,ikl)  = pbbcddir(iplon,ikl)  + zincflx*ztdbtc_nodel(iplon,iw,jk)  
              

! Accumulate direct fluxes for UV/visible bands
             if (ibm >= 10 .and. ibm <= 13) then
                puvcd(iplon,ikl)  = puvcd(iplon,ikl)  + zincflx*zcd(iplon,iw,jk)  
                puvcddir(iplon,ikl)  = puvcddir(iplon,ikl)  + zincflx*ztdbtc_nodel(iplon,iw,jk)  
                 
! Accumulate direct fluxes for near-IR bands
             else if (ibm == 14 .or. ibm <= 9) then  
                pnicd(iplon,ikl)  = pnicd(iplon,ikl)  + zincflx*zcd(iplon,iw,jk)  
                pnicddir(iplon,ikl)  = pnicddir(iplon,ikl)  + zincflx*ztdbtc_nodel(iplon,iw,jk)  
                 
             endif

          enddo          

! End loop on jb, spectral band
        enddo

! End of longitude loop    
      enddo               
!$acc end kernels



      if (cc==2) then

!$acc kernels 
        ILOOP_S_GPU
          WLOOP_S_GPU
            do jk=1,klev

               ikl=klev+1-jk
          WLOOP_S_CPU
               jb = ngb(iw)
               ibm = jb-15
!DIR$ SIMD
           ILOOP_S_CPU
               ! since the cloudy cases are now computed in a separate partition from the clear cases, we must
               ! recompute the needed clear sky prerequisites.
               ze1 = ztaur(iplon,ikl,iw) + ptaua(iplon,ikl,ibm) * pomga(iplon, ikl, ibm) 
               ze2 = pasya(iplon, ikl, ibm) * pomga(iplon, ikl, ibm) * ptaua(iplon, ikl, ibm) / ze1
               ze1 = ze1/ (ztaur(iplon,ikl,iw)  + ztaug(iplon,ikl,iw) + ptaua(iplon,ikl,ibm)  )
               
               ! compute delta scaled coefficients
               zf = ze2*ze2
               zwf = ze1*zf
               ze1 = (ze1 - zwf) / (1.0 - zwf)
               ze2 = (ze2 - zf) / (1.0 - zf)

               ! direct calculation of delta scaled values
               zomco(iplon,iw,jk)   = (ztauo(iplon,iw,jk) * ze1  + ptaucmc(iplon,ikl,iw)  * pomgcmc(iplon,ikl,iw))
               
               zgco(iplon, iw, jk) =  (ptaucmc(iplon,ikl,iw)  * pomgcmc(iplon,ikl,iw)  * pasycmc(iplon,ikl,iw) ) + &
                                      (ztauo(iplon, iw, jk) * ze1 * ze2)
               
               ztauo(iplon,iw,jk)   = ztauo(iplon,iw,jk) + ptaucmc(iplon,ikl,iw) 

               zgco(iplon,iw,jk)   = zgco(iplon, iw, jk) / zomco(iplon, iw, jk)
               zomco(iplon,iw,jk)  = zomco(iplon,iw,jk) / ztauo(iplon,iw,jk)
             
            end do    
          end do
        end do
!$acc end kernels


! Total sky reflectivities      
        call reftra_sw (ncol, nlayers, &
                        pcldfmc, zgco, prmu0, ztauo, zomco, &
                        zref, zrefd, ztra, ztrad, 0)
            

        klev = nlayers


!$acc kernels loop    
        ILOOP_S_GPU

!$acc loop
          WLOOP_S_GPU
            
!$acc loop seq
            do jk=1,klev

! Combine clear and cloudy contributions for total sky
               ikl = klev+1-jk 
          WLOOP_S_CPU
            ILOOP_S_CPU
               zclear = 1.0  - pcldfmc(iplon,ikl,iw) 
               zcloud = pcldfmc(iplon,ikl,iw) 

               zref(iplon,iw,jk)   = zclear*zrefo(iplon,iw,jk)   + zcloud*zref(iplon,iw,jk)  
               zrefd(iplon,iw,jk)  = zclear*zrefdo(iplon,iw,jk)   + zcloud*zrefd(iplon,iw,jk)  
               ztra(iplon,iw,jk)   = zclear*ztrao(iplon,iw,jk)   + zcloud*ztra(iplon,iw,jk)  
               ztrad(iplon,iw,jk)  = zclear*ztrado(iplon,iw,jk)   + zcloud*ztrad(iplon,iw,jk)  

! Clear + Cloud

               ze1 = ztauo(iplon,iw,jk )   / prmu0(iplon)   
#ifdef _ACCEL
               zdbtmo = exp(-ze1)            
#else
              if (ze1 .le. od_lo) then
                  zdbtmo = 1. - ze1 + 0.5 * ze1 * ze1
               else
                  tblind = ze1 / (bpade + ze1)
                  itind = tblint * tblind + 0.5
                  zdbtmo = exp_tbl(itind)
               endif
#endif
               ze1 = (ztauo(iplon,iw,jk) - ptaucmc(iplon,ikl,iw))  / prmu0(iplon)           
#ifdef _ACCEL
               zdbtmc = exp(-ze1)
#else
               if (ze1 .le. od_lo) then
                  zdbtmc = 1. - ze1 + 0.5 * ze1 * ze1
               else
                  tblind = ze1 / (bpade + ze1)
                  itind = tblint * tblind + 0.5
                  zdbtmc = exp_tbl(itind)
               endif
#endif
            
               zdbt(iplon,iw,jk)   = zclear*zdbtmc + zcloud*zdbtmo
               ztdbt(iplon,iw,jk+1)   = zdbt(iplon,iw,jk)  *ztdbt(iplon,iw,jk)  

            enddo          
          end do
        end do
!$acc end kernels

!$acc kernels
        zrdnd = 0.0
        zgco = 0.0
        zomco = 0.0
        zfd = 0.0
        zfu = 0.0
!$acc end kernels


!$acc kernels 
        ILOOP_S_GPU
          WLOOP_S_GPU

! Top of shortwave spectral band loop, jb = 16 -> 29; ibm = 1 -> 14

        WLOOP_S_CPU
            jb = ngb(iw)
            ibm = jb-15
          ILOOP_S_CPU

            zgco(iplon,iw,klev+1)   =palbp(iplon,ibm) 
            zomco(iplon,iw,klev+1)  =palbd(iplon,ibm) 
    
          end do
        end do
!$acc end kernels  


! Vertical quadrature for cloudy fluxes


        call vrtqdr_sw(ncol, klev, &
                       zref  , zrefd  , ztra  , ztrad , &
                       zdbt , zrdnd  , zgco, zomco , ztdbt  , &
                       zfd , zfu  ,  ztrao)

! Upwelling and downwelling fluxes at levels
!   Two-stream calculations go from top to bottom; 
!   layer indexing is reversed to go bottom to top for output arrays

        klev = nlayers
        repclc = 1.e-12 

!$acc kernels loop
        ILOOP_S_GPU
    
!$acc loop    
          do ikl=1,klev+1
!$acc loop seq
          WLOOP_S_GPU
          WLOOP_S_CPU
               jb = ngb(iw)
               jk=klev+2-ikl
               ibm = jb-15
            ILOOP_S_CPU
               zincflx = adjflux(jb)  * zsflxzen(iplon,iw)   * prmu0(iplon)           

! Accumulate spectral fluxes over whole spectrum  
               pbbfu(iplon,ikl)  = pbbfu(iplon,ikl)  + zincflx*zfu(iplon,iw,jk)  
               pbbfd(iplon,ikl)  = pbbfd(iplon,ikl)  + zincflx*zfd(iplon,iw,jk)              
               pbbfddir(iplon,ikl)  = pbbfddir(iplon,ikl)  + zincflx*ztdbt_nodel(iplon,iw,jk)  

! Accumulate direct fluxes for UV/visible bands
               if (ibm >= 10 .and. ibm <= 13) then
                 
                  puvfd(iplon,ikl)  = puvfd(iplon,ikl)  + zincflx*zfd(iplon,iw,jk)  
                  puvfddir(iplon,ikl)  = puvfddir(iplon,ikl)  + zincflx*ztdbt_nodel(iplon,iw,jk)  
                 
                 
! Accumulate direct fluxes for near-IR bands
               else if (ibm == 14 .or. ibm <= 9) then  
                
                  pnifd(iplon,ikl)  = pnifd(iplon,ikl)  + zincflx*zfd(iplon,iw,jk)  
                  pnifddir(iplon,ikl)  = pnifddir(iplon,ikl)  + zincflx*ztdbt_nodel(iplon,iw,jk)  
                   
                 
               endif

            enddo          

! End loop on jb, spectral band
          enddo

! End of longitude loop    
        enddo               
!$acc end kernels


      else      ! cc = 1
!$acc kernels
         pbbfd = pbbcd
         pbbfu = pbbcu
         puvfd = puvcd
         puvfddir = puvcddir
         pnifd = pnicd
         pnifddir = pnicddir
!$acc end kernels    
      end if    ! if cc=2, else, endif


!$acc kernels
      ILOOP_S_GPU
         WLOOP_S_GPU
      WLOOP_S_CPU
            jb = ngb(iw)
            ibm = jb - 15
         ILOOP_S_CPU
            zincflx = adjflux(jb)  * zsflxzen(iplon,iw)   * prmu0(iplon)    
            
         end do
      end do
!$acc end kernels

!!$acc end data
# undef ILOOP_S_GPU
# undef ILOOP_E_GPU
# undef ILOOP_S_CPU
# undef ILOOP_E_CPU
# undef WLOOP_S_GPU
# undef WLOOP_E_GPU
# undef WLOOP_S_CPU
# undef WLOOP_E_CPU
#ifndef _ACCEL
#  undef ncol
#endif
         
! !!!!!!!!!!!!!!!!!!!!!
!  END CLEAR  !!!!!!!!!
! !!!!!!!!!!!!!!!!!!!!!

      end subroutine spcvmc_sw
             
! --------------------------------------------------------------------
      subroutine reftra_sw(ncol, nlayers, pcldfmc, pgg, prmuzl, ptau, pw, &
                           pref, prefd, ptra, ptrad, ac)
! --------------------------------------------------------------------
  
! Purpose: computes the reflectivity and transmissivity of a clear or 
!   cloudy layer using a choice of various approximations.
!
! Interface:  *rrtmg_sw_reftra* is called by *rrtmg_sw_spcvrt*
!
! Description:
! explicit arguments :
! --------------------
! inputs
! ------ 
!      lrtchk  = .t. for all layers in clear profile
!      lrtchk  = .t. for cloudy layers in cloud profile 
!              = .f. for clear layers in cloud profile
!      pgg     = assymetry factor
!      prmuz   = cosine solar zenith angle
!      ptau    = optical thickness
!      pw      = single scattering albedo
!
! outputs
! -------
!      pref    : collimated beam reflectivity
!      prefd   : diffuse beam reflectivity 
!      ptra    : collimated beam transmissivity
!      ptrad   : diffuse beam transmissivity
!
!
! Method:
! -------
!      standard delta-eddington, p.i.f.m., or d.o.m. layer calculations.
!      kmodts  = 1 eddington (joseph et al., 1976)
!              = 2 pifm (zdunkowski et al., 1980)
!              = 3 discrete ordinates (liou, 1973)
!
! ac = 1 -- clear
! ac = 0 -- total (clear and cloudy)
!
! Modifications:
! --------------
! Original: J-JMorcrette, ECMWF, Feb 2003
! Revised for F90 reformatting: MJIacono, AER, Jul 2006
! Revised to add exponential lookup table: MJIacono, AER, Aug 2007
!
! ------------------------------------------------------------------

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

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

      integer , intent(in) :: nlayers
      integer , intent(in) :: ncol

      real,  intent(in) :: pcldfmc(:,:,:)                      ! Logical flag for reflectivity and
                                                               ! and transmissivity calculation; 
                                                               !   Dimensions: (ncol,nlayers,ngptsw)

      real , intent(in) gpu_device :: pgg(:,:,:)               ! asymmetry parameter
      real , intent(in) gpu_device :: ptau(:,:,:)              ! optical depth
      real , intent(in) gpu_device :: pw(:,:,:)                ! single scattering albedo 
                                                               !   Dimensions: (ncol,nlayers,ngptsw)

      real ,  intent(in) :: prmuzl(:)                          ! cosine of solar zenith angle
                                                               !   Dimensions: (ncol)
      integer, intent(in) :: ac

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

      real , intent(out) gpu_device :: pref(:,:,:)             ! direct beam reflectivity
      real , intent(out) gpu_device :: prefd(:,:,:)            ! diffuse beam reflectivity
      real , intent(out) gpu_device :: ptra(:,:,:)             ! direct beam transmissivity
      real , intent(out) gpu_device :: ptrad(:,:,:)            ! diffuse beam transmissivity
                                                               !   Dimensions: (ncol,nlayers,ngptsw)

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

      integer  :: jk, jl, kmodts
      integer  :: itind, iplon, iw

      real  :: tblind
      real  :: za, za1, za2
      real  :: zbeta, zdend, zdenr, zdent
      real  :: ze1, ze2, zem1, zem2, zemm, zep1, zep2
      real  :: zg, zg3, zgamma1, zgamma2, zgamma3, zgamma4, zgt
      real  :: zr1, zr2, zr3, zr4, zr5
      real  :: zrk, zrk2, zrkg, zrm1, zrp, zrp1, zrpp
      real  :: zsr3, zt1, zt2, zt3, zt4, zt5, zto1
      real  :: zw, zwcrit, zwo, prmuz

      real , parameter :: eps = 1.e-08 

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

! Initialize

      zsr3=sqrt(3. )
      zwcrit=0.9999995 
      kmodts=2
      
!$acc kernels loop
      do iplon=1,ncol
!$acc loop
        do iw=1,112
!$acc loop private(zgamma1, zgamma2, zgamma3, zgamma4)
          do jk=1, nlayers
             prmuz = prmuzl(iplon)
             if ((.not.(pcldfmc(iplon,nlayers+1-jk,iw))  > 1.e-12) .and. ac==0  ) then
               pref(iplon,iw,jk)   =0. 
               ptra(iplon,iw,jk)   =1. 
               prefd(iplon,iw,jk)  =0. 
               ptrad(iplon,iw,jk)  =1. 
             else
               zto1=ptau(iplon,iw,jk)  
               zw  =pw(iplon,iw,jk)  
               zg  =pgg(iplon,iw,jk)    

! General two-stream expressions

               zg3= 3.  * zg
           
               zgamma1= (8.  - zw * (5.  + zg3)) * 0.25 
               zgamma2=  3.  *(zw * (1.  - zg )) * 0.25 
               zgamma3= (2.  - zg3 * prmuz ) * 0.25 
       
               zgamma4= 1.  - zgamma3
    
! Recompute original s.s.a. to test for conservative solution

               zwo= zw / (1.  - (1.  - zw) * (zg / (1.  - zg))**2)
    
               if (zwo >= zwcrit) then
! Conservative scattering

                  za  = zgamma1 * prmuz 
                  za1 = za - zgamma3
                  zgt = zgamma1 * zto1
        
! Homogeneous reflectance and transmittance,
! collimated beam

                  ze1 = min ( zto1 / prmuz , 500. )


                  ze2 = exp(-ze1)
                  pref(iplon,iw,jk)   = (zgt - za1 * (1.  - ze2)) / (1.  + zgt)
                  ptra(iplon,iw,jk)   = 1.  - pref(iplon,iw,jk)  

! isotropic incidence

                  prefd(iplon,iw,jk)   = zgt / (1.  + zgt)
                  ptrad(iplon,iw,jk)   = 1.  - prefd(iplon,iw,jk)          

! This is applied for consistency between total (delta-scaled) and direct (unscaled) 
! calculations at very low optical depths (tau < 1.e-4) when the exponential lookup
! table returns a transmittance of 1.0.
                  if (ze2 .eq. 1.0 ) then 
                     pref(iplon,iw,jk)   = 0.0 
                     ptra(iplon,iw,jk)   = 1.0 
                     prefd(iplon,iw,jk)   = 0.0 
                     ptrad(iplon,iw,jk)   = 1.0 
                  endif

               else
! Non-conservative scattering

                  za1 = zgamma1 * zgamma4 + zgamma2 * zgamma3
                  za2 = zgamma1 * zgamma3 + zgamma2 * zgamma4
                  zrk = sqrt ( zgamma1**2 - zgamma2**2)
                  zrp = zrk * prmuz               
                  zrp1 = 1.  + zrp
                  zrm1 = 1.  - zrp
                  zrk2 = 2.  * zrk
                  zrpp = 1.  - zrp*zrp
                  zrkg = zrk + zgamma1
                  zr1  = zrm1 * (za2 + zrk * zgamma3)
                  zr2  = zrp1 * (za2 - zrk * zgamma3)
                  zr3  = zrk2 * (zgamma3 - za2 * prmuz )
                  zr4  = zrpp * zrkg
                  zr5  = zrpp * (zrk - zgamma1)
                  zt1  = zrp1 * (za1 + zrk * zgamma4)
                  zt2  = zrm1 * (za1 - zrk * zgamma4)
                  zt3  = zrk2 * (zgamma4 + za1 * prmuz )
                  zt4  = zr4
                  zt5  = zr5

! mji - reformulated code to avoid potential floating point exceptions
!               zbeta = - zr5 / zr4
                  zbeta = (zgamma1 - zrk) / zrkg
!!
        
! Homogeneous reflectance and transmittance

                  ze1 = min ( zrk * zto1, 5. )
                  ze2 = min ( zto1 / prmuz , 5. )
           
! Use exponential lookup table for transmittance, or expansion of 
! exponential for low tau
                  if (ze1 .le. od_lo) then 
                     zem1 = 1.  - ze1 + 0.5  * ze1 * ze1
                     zep1 = 1.  / zem1
                  else
                     zem1 = exp(-ze1)
                     zep1 = 1.  / zem1
                  endif
                  if (ze2 .le. od_lo) then 
                     zem2 = 1.  - ze2 + 0.5  * ze2 * ze2
                     zep2 = 1.  / zem2
                  else
                     zem2 = exp(-ze2)
                     zep2 = 1.  / zem2
                  endif

                  zdenr = zr4*zep1 + zr5*zem1
                  zdent = zt4*zep1 + zt5*zem1
                  if (zdenr .ge. -eps .and. zdenr .le. eps) then
                     pref(iplon,iw,jk)   = eps
                     ptra(iplon,iw,jk)   = zem2
                  else 
                     pref(iplon,iw,jk)   = zw * (zr1*zep1 - zr2*zem1 - zr3*zem2) / zdenr
                     ptra(iplon,iw,jk)   = zem2 - zem2 * zw * (zt1*zep1 - zt2*zem1 - zt3*zep2) / zdent
                  endif

! diffuse beam

                  zemm = zem1*zem1
                  zdend = 1.  / ( (1.  - zbeta*zemm ) * zrkg)
                  prefd(iplon,iw,jk)   =  zgamma2 * (1.  - zemm) * zdend
                  ptrad(iplon,iw,jk)   =  zrk2*zem1*zdend

               endif

            endif         

          end do  
        end do
      end do
!$acc end kernels

      end subroutine reftra_sw
                           
! --------------------------------------------------------------------------
      subroutine vrtqdr_sw(ncol, klev, &
                           pref, prefd, ptra, ptrad, &
                           pdbt, prdnd, prup, prupd, ptdbt, &
                           pfd, pfu, ztdn)
! --------------------------------------------------------------------------
 
! Purpose: This routine performs the vertical quadrature integration
!
! Interface:  *vrtqdr_sw* is called from *spcvrt_sw* and *spcvmc_sw*
!
! Modifications.
! 
! Original: H. Barker
! Revision: Integrated with rrtmg_sw, J.-J. Morcrette, ECMWF, Oct 2002
! Revision: Reformatted for consistency with rrtmg_lw: MJIacono, AER, Jul 2006
!
!-----------------------------------------------------------------------

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

! Input

      integer , intent (in) :: klev                           ! number of model layers
      integer , intent (in) :: ncol
    

#ifdef _ACCEL
      real , intent(in) gpu_device :: pref(:,:,:)             ! direct beam reflectivity
      real , intent(in) gpu_device :: prefd(:,:,:)            ! diffuse beam reflectivity
      real , intent(in) gpu_device :: ptra(:,:,:)             ! direct beam transmissivity
      real , intent(in) gpu_device :: ptrad(:,:,:)            ! diffuse beam transmissivity
      real , intent(in) gpu_device :: pdbt(:,:,:)  
      real , intent(in) gpu_device :: ptdbt(:,:,:)  
      real , intent(out) gpu_device :: prdnd(:,:,:)  
      real , intent(inout) gpu_device :: prup(:,:,:)  
      real , intent(inout) gpu_device  :: prupd(:,:,:)  
      real, intent(inout) gpu_device :: ztdn(:,:,:)
                                                              !   Dimensions: (ncol,nlayers,ngptsw)
                                                              
! Output
      real , intent(out) gpu_device  :: pfd(:,:,:)            ! downwelling flux (W/m2)
                                                              ! unadjusted for earth/sun distance or zenith angle
      real , intent(inout) gpu_device  :: pfu(:,:,:)          ! upwelling flux (W/m2)
                                                              ! unadjusted for earth/sun distance or zenith angle
                                                              !   Dimensions: (ncol,nlayers,ngptsw)
#else
      real , intent(in) :: pref(CHNK,112,klev+1)             ! direct beam reflectivity
      real , intent(in) :: prefd(CHNK,112,klev+1)            ! diffuse beam reflectivity
      real , intent(in) :: ptra(CHNK,112,klev+1)             ! direct beam transmissivity
      real , intent(in) :: ptrad(CHNK,112,klev+1)            ! diffuse beam transmissivity
      real , intent(in) :: pdbt(CHNK,112,klev+1)
      real , intent(in) :: ptdbt(CHNK,112,klev+1)
      real , intent(out) :: prdnd(CHNK,112,klev+1)
      real , intent(inout) :: prup(CHNK,112,klev+1)
      real , intent(inout)  :: prupd(CHNK,112,klev+1)
      real, intent(inout) :: ztdn(CHNK,112,klev+1)
                                                              !   Dimensions: (ncol,nlayers,ngptsw)

! Output
      real , intent(out) gpu_device  :: pfd(CHNK,112,klev+1)            ! downwelling flux (W/m2)
                                                              ! unadjusted for earth/sun distance or zenith angle
      real , intent(inout) gpu_device  :: pfu(CHNK,112,klev+1)          ! upwelling flux (W/m2)
                                                              ! unadjusted for earth/sun distance or zenith angle
                                                              !   Dimensions: (ncol,nlayers,ngptsw)
#endif

! Local

      integer  :: ikp, ikx, jk, iplon, iw

#ifdef _ACCEL

      real  :: zreflect, zreflectj

# define ILOOP_S_CPU 
# define ILOOP_E_CPU
# define ILOOP_S_GPU do iplon = 1, ncol
# define ILOOP_E_GPU enddo
# define WLOOP_S_CPU 
# define WLOOP_E_CPU 
# define WLOOP_S_GPU do iw = 1, 112
# define WLOOP_E_GPU enddo

#else

!      real, dimension(CHNK)  :: zreflect, zreflectj
      real  :: zreflect, zreflectj

# define ncol CHNK

# define ILOOP_S_GPU 
# define ILOOP_E_GPU 
# define ILOOP_S_CPU do iplon = 1, ncol
# define ILOOP_E_CPU enddo
# define WLOOP_S_GPU 
# define WLOOP_E_GPU 
# define WLOOP_S_CPU do iw = 1, 112
# define WLOOP_E_CPU enddo

!# define zreflect ZREFLECT(iplon)
!# define zreflectj ZREFLECTJ(iplon)

#endif
     
! Definitions
!
! pref(jk)   direct reflectance
! prefd(jk)  diffuse reflectance
! ptra(jk)   direct transmittance
! ptrad(jk)  diffuse transmittance
!
! pdbt(jk)   layer mean direct beam transmittance
! ptdbt(jk)  total direct beam transmittance at levels
!
!-----------------------------------------------------------------------------
                   
! Link lowest layer with surface
! this kernel has a lot of dependencies

!               CHNK       hardcode      klev+1
! pref            8         112          52
! prefd            8         112          52
! ptra            8         112          52
! ptrad            8         112          52
! pdbt            8         112          52
! ptdbt            8         112          52
! prdnd            8         112          52
! prup            8         112          52
! prupd            8         112          52
! ztdn            8         112          52
! pfd            8         112          52
! pfu            8         112          52
!DIR$ ASSUME_ALIGNED pref:64,prefd:64,ptra:64,ptrad:64
!DIR$ ASSUME_ALIGNED pdbt:64,ptdbt:64,prdnd:64,prup:64,prupd:64,ztdn:64,pfd:64,pfu:64

#if 0
write(0,*)'pref ',shape( pref)             ! direct beam reflectivity
write(0,*)'prefd ',shape( prefd)            ! diffuse beam reflectivity
write(0,*)'ptra ',shape( ptra)             ! direct beam transmissivity
write(0,*)'ptrad ',shape( ptrad)            ! diffuse beam transmissivity
write(0,*)'pdbt ',shape( pdbt)
write(0,*)'ptdbt ',shape( ptdbt)
write(0,*)'prdnd ',shape( prdnd)
write(0,*)'prup ',shape( prup)
write(0,*)'prupd ',shape( prupd)
write(0,*)'ztdn ',shape( ztdn)
write(0,*)'pfd ',shape( pfd)            ! downwelling flux (W/m2)
write(0,*)'pfu ',shape( pfu)          ! upwelling flux (W/m2)
#endif



!$acc kernels loop
      ILOOP_S_GPU

!$acc loop private(zreflect)
        WLOOP_S_GPU
         WLOOP_S_CPU
!DIR$ VECTOR ALIGNED
           ILOOP_S_CPU
            zreflect = 1.  / (1.  - prefd(iplon,iw,klev+1)   * prefd(iplon,iw,klev)  )
            prup(iplon,iw,klev)   = pref(iplon,iw,klev)   + (ptrad(iplon,iw,klev)   * &
                 ((ptra(iplon,iw,klev)   - pdbt(iplon,iw,klev)  ) * prefd(iplon,iw,klev+1)   + &
                   pdbt(iplon,iw,klev)   * pref(iplon,iw,klev+1)  )) * zreflect
            prupd(iplon,iw,klev)   = prefd(iplon,iw,klev)   + ptrad(iplon,iw,klev)   * ptrad(iplon,iw,klev)   * &
                    prefd(iplon,iw,klev+1)   * zreflect
           ILOOP_E_CPU
         WLOOP_E_GPU
        WLOOP_E_CPU
      ILOOP_E_GPU
!$acc end kernels
      
! Pass from bottom to top 
!$acc kernels loop
      ILOOP_S_GPU

!$acc loop    
       WLOOP_S_GPU

!$acc loop seq 
            do jk = 1,klev-1
               ikp = klev+1-jk                       
               ikx = ikp-1
         WLOOP_S_CPU
!DIR$ VECTOR ALIGNED
           ILOOP_S_CPU
               zreflectj = 1.  / (1.  -prupd(iplon,iw,ikp)   * prefd(iplon,iw,ikx)  )
               prup(iplon,iw,ikx)   = pref(iplon,iw,ikx)   + (ptrad(iplon,iw,ikx)   * &
                   ((ptra(iplon,iw,ikx)   - pdbt(iplon,iw,ikx)  ) * prupd(iplon,iw,ikp)   + &
                     pdbt(iplon,iw,ikx)   * prup(iplon,iw,ikp)  )) * zreflectj
               prupd(iplon,iw,ikx)   = prefd(iplon,iw,ikx)   + ptrad(iplon,iw,ikx)   * ptrad(iplon,iw,ikx)   * &
                      prupd(iplon,iw,ikp)   * zreflectj
           ILOOP_E_CPU
         WLOOP_E_CPU
            end do
       WLOOP_E_GPU
      ILOOP_E_GPU
!$acc end kernels

!$acc kernels loop
      ILOOP_S_GPU
!$acc loop
        WLOOP_S_GPU
         WLOOP_S_CPU

! Upper boundary conditions
!DIR$ VECTOR ALIGNED
           ILOOP_S_CPU
            ztdn(iplon, iw, 1) = 1. 
            prdnd(iplon,iw,1)   = 0. 
            ztdn(iplon, iw, 2) = ptra(iplon,iw,1)  
            prdnd(iplon,iw,2)   = prefd(iplon,iw,1)  
           ILOOP_E_CPU
         WLOOP_E_GPU
        WLOOP_E_CPU
      ILOOP_E_GPU
!$acc end kernels      
      
!$acc kernels loop
      ILOOP_S_GPU
!$acc loop
       WLOOP_S_GPU

! Pass from top to bottom
!$acc loop seq
            do jk = 2,klev
               ikp = jk+1
         WLOOP_S_CPU
!DIR$ VECTOR ALIGNED
           ILOOP_S_CPU
               zreflect = 1.  / (1.  - prefd(iplon,iw,jk)   * prdnd(iplon,iw,jk)  )
               ztdn(iplon, iw, ikp) = ptdbt(iplon,iw,jk)   * ptra(iplon,iw,jk)   + &
                    (ptrad(iplon,iw,jk)   * ((ztdn(iplon, iw, jk) - ptdbt(iplon,iw,jk)  ) + &
                     ptdbt(iplon,iw,jk)   * pref(iplon,iw,jk)   * prdnd(iplon,iw,jk)  )) * zreflect
               prdnd(iplon,iw,ikp)   = prefd(iplon,iw,jk)   + ptrad(iplon,iw,jk)   * ptrad(iplon,iw,jk)   * &
                      prdnd(iplon,iw,jk)   * zreflect
           ILOOP_E_CPU
         WLOOP_E_CPU
            end do
       WLOOP_E_GPU
      ILOOP_E_GPU
!$acc end kernels
    
! Up and down-welling fluxes at levels

!$acc kernels loop
      ILOOP_S_GPU
!$acc loop
       WLOOP_S_GPU
!$acc loop 
            do jk = 1,klev+1
         WLOOP_S_CPU
!DIR$ VECTOR ALIGNED
           ILOOP_S_CPU
               zreflect = 1.  / (1.  - prdnd(iplon,iw,jk)   * prupd(iplon,iw,jk)  )
               pfu(iplon,iw,jk)   = (ptdbt(iplon,iw,jk)   * prup(iplon,iw,jk)   + &
                      (ztdn(iplon, iw, jk) - ptdbt(iplon,iw,jk)  ) * prupd(iplon,iw,jk)  ) * zreflect
               pfd(iplon,iw,jk)   = ptdbt(iplon,iw,jk)   + (ztdn(iplon, iw, jk) - ptdbt(iplon,iw,jk)  + &
                      ptdbt(iplon,iw,jk)   * prup(iplon,iw,jk)   * prdnd(iplon,iw,jk)  ) * zreflect
           ILOOP_E_CPU
         WLOOP_E_CPU
            end do
       WLOOP_E_GPU
      ILOOP_E_GPU
!$acc end kernels
      
      end subroutine vrtqdr_sw

      end module rrtmg_sw_spcvmc_f
# undef ILOOP_S_GPU 
# undef ILOOP_E_GPU 
# undef ILOOP_S_CPU
# undef ILOOP_E_CPU
# undef WLOOP_S_GPU 
# undef WLOOP_E_GPU 
# undef WLOOP_S_CPU
# undef WLOOP_E_CPU
# undef zreflect
# undef zreflectj
# undef ncol

      module rrtmg_sw_rad_f
!
! ****************************************************************************
! *                                                                          *
! *                             RRTMG_SW                                     *
! *                                                                          *
! *                                                                          *
! *                                                                          *
! *                 a rapid radiative transfer model                         *
! *                  for the solar spectral region                           *
! *           for application to general circulation models                  *
! *                                                                          *
! *                                                                          *
! *           Atmospheric and Environmental Research, Inc.                   *
! *                       131 Hartwell Avenue                                *
! *                       Lexington, MA 02421                                *
! *                                                                          *
! *                                                                          *
! *                          Eli J. Mlawer                                   *
! *                       Jennifer S. Delamere                               *
! *                        Michael J. Iacono                                 *
! *                        Shepard A. Clough                                 *
! *                       David M. Berthiaume                                *
! *                                                                          *
! *                                                                          *
! *                                                                          *
! *                                                                          *
! *                                                                          *
! *                      email:  miacono@aer.com                             *
! *                      email:  emlawer@aer.com                             *
! *                      email:  jdelamer@aer.com                            *
! *                                                                          *
! *       The authors wish to acknowledge the contributions of the           *
! *       following people:  Steven J. Taubman, Patrick D. Brown,            *
! *       Ronald E. Farren, Luke Chen, Robert Bergstrom.                     *
! *                                                                          *
! ****************************************************************************
    
! --------- Modules ---------

      use rrsw_vsn_f
      use mcica_subcol_gen_sw_f, only: mcica_sw
      use rrtmg_sw_cldprmc_f, only: cldprmc_sw
      use rrtmg_sw_setcoef_f, only: setcoef_sw
      use rrtmg_sw_spcvmc_f, only: spcvmc_sw

      implicit none

      public :: rrtmg_sw,  earth_sun

      INTEGER, PARAMETER :: debug_level_swf=100

      contains
    
      subroutine rrtmg_sw &
            (rpart   ,ncol    ,nlay    ,icld    ,iaer   , &
             play    ,plev    ,tlay    ,tlev    ,tsfc   , &
             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr ,o2vmr , &
             asdir   ,asdif   ,aldir   ,aldif   , &
             coszen  ,adjes   ,dyofyr  ,scon    , &
             inflgsw ,iceflgsw,liqflgsw,cld     , &
             tauc    ,ssac    ,asmc    ,fsfc    , &
             ciwp    ,clwp    ,cswp    ,rei     ,rel    ,res   , &
             tauaer  ,ssaaer  ,asmaer  ,ecaer   , &
             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc,swhrc , &
! --------- Add the following four compenants for ssib shortwave down radiation ---!
! -------------------      by Zhenxin 2011-06-20      --------------------------------!
             sibvisdir, sibvisdif, sibnirdir, sibnirdif,         &
! ----------------------  End,  Zhenxin 2011-06-20    --------------------------------!
             swdkdir,   swdkdif                                  & ! jararias, 2013/08/10
                                )


      use parrrsw_f, only : nbndsw, ngptsw, naerec, nstr, nmol, mxmol, &
                          jpband, jpb1, jpb2, rrsw_scon
      use rrsw_aer_f, only : rsrtaua, rsrpiza, rsrasya
      use rrsw_con_f, only : heatfac, oneminus, pi,  grav, avogad
      use rrsw_wvn_f, only : wavenum1, wavenum2
      use rrsw_cld_f, only : extliq1, ssaliq1, asyliq1, &
                           extice2, ssaice2, asyice2, &
                           extice3, ssaice3, asyice3, fdlice3, &
                           abari, bbari, cbari, dbari, ebari, fbari
      use rrsw_wvn_f, only : wavenum2, ngb
      use rrsw_ref_f, only : preflog, tref

#ifdef _ACCEL
      use cudafor
#endif 


! ------- Declarations

      integer , intent(in) :: rpart           ! The number of columns in each partition
      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
      integer , intent(in) :: iaer            ! Aerosol option flag
      real , intent(in) :: play(:,:)          ! Layer pressures (hPa, mb)
                                              !    Dimensions: (ncol,nlay)
      real , intent(in) :: plev(:,:)          ! Interface pressures (hPa, mb)
                                              !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: tlay(:,:)          ! Layer temperatures (K)
                                              !    Dimensions: (ncol,nlay)
      real , intent(in) :: tlev(:,:)          ! 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) :: asdir(:)           ! UV/vis surface albedo direct rad
                                              !    Dimensions: (ncol)
      real , intent(in) :: aldir(:)           ! Near-IR surface albedo direct rad
                                              !    Dimensions: (ncol)
      real , intent(in) :: asdif(:)           ! UV/vis surface albedo: diffuse rad
                                              !    Dimensions: (ncol)
      real , intent(in) :: aldif(:)           ! Near-IR surface albedo: diffuse rad
                                              !    Dimensions: (ncol)

      integer , intent(in) :: dyofyr          ! Day of the year (used to get Earth/Sun
                                              !  distance if adjflx not provided)
      real , intent(in) :: adjes              ! Flux adjustment for Earth/Sun distance
      real , intent(in) :: coszen(:)          ! Cosine of solar zenith angle
                                              !    Dimensions: (ncol)
      real , intent(in) :: scon               ! Solar constant (W/m2)

      integer , intent(in) :: inflgsw         ! Flag for cloud optical properties
      integer , intent(in) :: iceflgsw        ! Flag for ice particle specification
      integer , intent(in) :: liqflgsw        ! Flag for liquid droplet specification

      real , intent(in) :: cld(:,:)           ! Cloud fraction
                                              !    Dimensions: (ncol,nlay)
      real , intent(in) :: tauc(:,:,:)        ! In-cloud optical depth
                                              !    Dimensions: (ncol,nlay,nbndlw)
      real , intent(in) :: ssac(:,:,:)        ! In-cloud single scattering albedo
                                              !    Dimensions: (ncol,nlay,nbndlw)
      real , intent(in) :: asmc(:,:,:)        ! In-cloud asymmetry parameter
                                              !    Dimensions: (ncol,nlay,nbndlw)
      real , intent(in) :: fsfc(:,:,:)        ! In-cloud forward scattering fraction
                                              !    Dimensions: (ncol,nlay,nbndlw)
      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 effective radius (microns)
                                              !    Dimensions: (ncol, nlay)
                                              ! specific definition of rei 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) :: tauaer(:,:,:)      ! Aerosol optical depth (iaer=10 only)
                                              !    Dimensions: (ncol,nlay,nbndsw)
                                              ! (non-delta scaled)      
      real , intent(in) :: ssaaer(:,:,:)      ! Aerosol single scattering albedo (iaer=10 only)
                                              !    Dimensions: (ncol,nlay,nbndsw)
                                              ! (non-delta scaled)      
      real , intent(in) :: asmaer(:,:,:)      ! Aerosol asymmetry parameter (iaer=10 only)
                                              !    Dimensions: (ncol,nlay,nbndsw)
                                              ! (non-delta scaled)      
      real , intent(in) :: ecaer(:,:,:)       ! Aerosol optical depth at 0.55 micron (iaer=6 only)
                                              !    Dimensions: (ncol,nlay,naerec)
                                              ! (non-delta scaled)      
                                              
! ----- Output -----

      real , intent(out) :: swuflx(:,:)       ! Total sky shortwave upward flux (W/m2)
                                              !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swdflx(:,:)       ! Total sky shortwave downward flux (W/m2)
                                              !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swhr(:,:)         ! Total sky shortwave radiative heating rate (K/d)
                                              !    Dimensions: (ncol,nlay)
      real , intent(out) :: swuflxc(:,:)      ! Clear sky shortwave upward flux (W/m2)
                                              !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swdflxc(:,:)      ! Clear sky shortwave downward flux (W/m2)
                                              !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swhrc(:,:)        ! Clear sky shortwave radiative heating rate (K/d)
                                              !    Dimensions: (ncol,nlay)

      real, intent(out) :: sibvisdir(:,:)      ! visible direct downward flux  (W/m2)
                                               !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
      real, intent(out) :: sibvisdif(:,:)      ! visible diffusion downward flux  (W/m2)
                                               !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
      real, intent(out) :: sibnirdir(:,:)      ! Near IR direct downward flux  (W/m2)
                                               !    Dimensions: (ncol,nlay+1)  Zhenxin (2011/06/20)
      real, intent(out) :: sibnirdif(:,:)      ! Near IR diffusion downward flux  (W/m2)
                                               !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
      real, intent(out) :: swdkdir(:,:)        ! Total shortwave downward direct flux (W/m2)
                                               !    Dimensions: (ncol,nlay+1) jararias, 2013/08/10
      real, intent(out) :: swdkdif(:,:)        ! Total shortwave downward diffuse flux (W/m2)
                                               !    Dimensions: (ncol,nlay+1) jararias, 2013/08/10

      integer :: npart, pncol, ns
      CHARACTER(LEN=256) :: message

! mji - time
      real :: t1, t2
      
#ifdef _ACCEL
      type(cudadeviceprop) :: prop
      real :: gmem
      integer :: err
      integer :: munits
#endif

      if (rpart > 0) then
         pncol = rpart
      else

#ifdef _ACCEL
 
      err = cudaGetDeviceProperties( prop, 0)
      gmem = prop%totalGlobalMem / (1024.0 * 1024.0)
!      print *, "Total GPU global memory is ", gmem , "MB"
      
      ! dmb 2013
      ! Here 
      ! The optimal partition size is determined by the following conditions
      ! 1. Powers of 2 are the most efficient.
      ! 2. The second to largest power of 2 that can fit on 
      !    the GPU is most efficient.
      ! 3. Having a small remainder for the final partiion is inefficient.
      
      if (gmem > 5000) then
         pncol = 4096
      else if (gmem > 3000) then
         pncol = 2048
      else if (gmem > 1000) then
          pncol = 1024
      else 
          pncol = 512
      end if  
         
      ! the smallest allowed partition size is 32
      do err = 1, 6
          if (pncol > ncol .and. pncol>32) then 
              pncol = pncol/2
          end if
      end do
      
      ! if we have a very large number of columns, account for the 
      ! static ncol memory requirement 
      if (ncol>29000 .and. pncol>4000) then
          pncol = pncol/2
      end if

#else
      pncol = 2
      pncol = 4
!jm      pncol = CHNK  redundant, since this is passed in
      
#endif    
          
      end if

      WRITE(message,*)'RRTMG_SWF: Number of columns is               ',ncol
      call wrf_debug( debug_level_swf, message)
      WRITE(message,*)'RRTMG_SWF: Number of columns per partition is ',pncol
      call wrf_debug( debug_level_swf, message)
      ns = ceiling( real(ncol) / real(pncol) )
      WRITE(message,*)'RRTMG_SWF: Number of partitions is            ',ns
      call wrf_debug( debug_level_swf, message)

      call cpu_time(t1)
                                                      
      call rrtmg_sw_sub &
            (pncol   ,ncol    ,nlay    ,icld    ,iaer   , &
             play    ,plev    ,tlay    ,tlev    ,tsfc   , &
             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr ,o2vmr , &
             asdir   ,asdif   ,aldir   ,aldif   , &
             coszen  ,adjes   ,dyofyr  ,scon    , &
             inflgsw ,iceflgsw,liqflgsw,cld     , &
             tauc    ,ssac    ,asmc    ,fsfc    , &
             ciwp    ,clwp    ,cswp    ,rei     ,rel    ,res   , &
             tauaer  ,ssaaer  ,asmaer  ,ecaer   , &
             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc, &
             sibvisdir, sibvisdif, sibnirdir, sibnirdif,         &
             swdkdir  , swdkdif                                  & ! jararias, 2013/08/10
                                )
      call cpu_time(t2)
      WRITE(message,*)'------------------------------------------------'
      call wrf_debug( debug_level_swf, message)
      WRITE(message,*)'TOTAL RRTMG_SWF RUN TIME IS   ', t2-t1
      call wrf_debug( debug_level_swf, message)
      WRITE(message,*)'------------------------------------------------'
      call wrf_debug( debug_level_swf, message)
                                                      
      end subroutine rrtmg_sw                                                     


      subroutine rrtmg_sw_sub &
            (ncol    ,gncol   ,nlay    ,icld    ,iaer    , &
             gplay   ,gplev   ,gtlay   ,gtlev   ,gtsfc   , &
             gh2ovmr ,go3vmr  ,gco2vmr ,gch4vmr ,gn2ovmr ,go2vmr , &
             gasdir  ,gasdif  ,galdir  ,galdif  , &
             gcoszen ,adjes   ,dyofyr  ,scon    , &
             inflgsw ,iceflgsw,liqflgsw,gcld    , &
             gtauc   ,gssac   ,gasmc   ,gfsfc   , &
             gciwp   ,gclwp   ,gcswp   ,grei    ,grel    ,gres   , &
             gtauaer ,gssaaer ,gasmaer ,gecaer  , &
             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc, &
             sibvisdir, sibvisdif, sibnirdir, sibnirdif,         &
             swdkdir  , swdkdif                                  & ! jararias, 2013/08/10
                                )
      use parrrsw_f, only : nbndsw, ngptsw, naerec, nstr, nmol, mxmol, &
                          jpband, jpb1, jpb2, rrsw_scon
      use rrsw_aer_f, only : rsrtaua, rsrpiza, rsrasya
      use rrsw_con_f, only : heatfac, oneminus, pi,  grav, avogad
      use rrsw_wvn_f, only : wavenum1, wavenum2
      use rrsw_cld_f, only : extliq1, ssaliq1, asyliq1, &
                           extice2, ssaice2, asyice2, &
                           extice3, ssaice3, asyice3, fdlice3, &
                           abari, bbari, cbari, dbari, ebari, fbari
      use rrsw_wvn_f, only : wavenum2, ngb, icxa, nspa, nspb
      use rrsw_ref_f, only : preflog, tref
      use rrsw_kg16_f, kao16 => kao, kbo16 => kbo, selfrefo16 => selfrefo, forrefo16 => forrefo, sfluxrefo16 => sfluxrefo
      use rrsw_kg16_f, ka16 => ka, kb16 => kb, selfref16 => selfref, forref16 => forref, sfluxref16 => sfluxref

      use rrsw_kg17_f, kao17 => kao, kbo17 => kbo, selfrefo17 => selfrefo, forrefo17 => forrefo, sfluxrefo17 => sfluxrefo
      use rrsw_kg17_f, ka17 => ka, kb17 => kb, selfref17 => selfref, forref17 => forref, sfluxref17 => sfluxref

      use rrsw_kg18_f, kao18 => kao, kbo18 => kbo, selfrefo18 => selfrefo, forrefo18 => forrefo, sfluxrefo18 => sfluxrefo
      use rrsw_kg18_f, ka18 => ka, kb18 => kb, selfref18 => selfref, forref18 => forref, sfluxref18 => sfluxref

      use rrsw_kg19_f, kao19 => kao, kbo19 => kbo, selfrefo19 => selfrefo, forrefo19 => forrefo, sfluxrefo19 => sfluxrefo
      use rrsw_kg19_f, ka19 => ka, kb19 => kb, selfref19 => selfref, forref19 => forref, sfluxref19 => sfluxref

      use rrsw_kg20_f, kao20 => kao, kbo20 => kbo, selfrefo20 => selfrefo, forrefo20 => forrefo, &
          sfluxrefo20 => sfluxrefo, absch4o20 => absch4o
      use rrsw_kg20_f, ka20 => ka, kb20 => kb, selfref20 => selfref, forref20 => forref, &
          sfluxref20 => sfluxref, absch420 => absch4

      use rrsw_kg21_f, kao21 => kao, kbo21 => kbo, selfrefo21 => selfrefo, forrefo21 => forrefo, sfluxrefo21 => sfluxrefo
      use rrsw_kg21_f, ka21 => ka, kb21 => kb, selfref21 => selfref, forref21 => forref, sfluxref21 => sfluxref

      use rrsw_kg22_f, kao22 => kao, kbo22 => kbo, selfrefo22 => selfrefo, forrefo22 => forrefo, sfluxrefo22 => sfluxrefo
      use rrsw_kg22_f, ka22 => ka, kb22 => kb, selfref22 => selfref, forref22 => forref, sfluxref22 => sfluxref

      use rrsw_kg23_f, kao23 => kao, selfrefo23 => selfrefo, forrefo23 => forrefo, sfluxrefo23 => sfluxrefo, raylo23 => raylo
      use rrsw_kg23_f, ka23 => ka, selfref23 => selfref, forref23 => forref, sfluxref23 => sfluxref, rayl23 => rayl

      use rrsw_kg24_f, kao24 => kao, kbo24 => kbo, selfrefo24 => selfrefo, forrefo24 => forrefo, sfluxrefo24 => sfluxrefo
      use rrsw_kg24_f, abso3ao24 => abso3ao, abso3bo24 => abso3bo, raylao24 => raylao, raylbo24 => raylbo
      use rrsw_kg24_f, ka24 => ka, kb24 => kb, selfref24 => selfref, forref24 => forref, sfluxref24 => sfluxref
      use rrsw_kg24_f, abso3a24 => abso3a, abso3b24 => abso3b, rayla24 => rayla, raylb24 => raylb

      use rrsw_kg25_f, kao25 => kao, sfluxrefo25=>sfluxrefo
      use rrsw_kg25_f, abso3ao25 => abso3ao, abso3bo25 => abso3bo, raylo25 => raylo
      use rrsw_kg25_f, ka25 => ka, sfluxref25=>sfluxref
      use rrsw_kg25_f, abso3a25 => abso3a, abso3b25 => abso3b, rayl25 => rayl
     
      use rrsw_kg26_f, sfluxrefo26 => sfluxrefo
      use rrsw_kg26_f, sfluxref26 => sfluxref

      use rrsw_kg27_f, kao27 => kao, kbo27 => kbo, sfluxrefo27 => sfluxrefo, rayl27=>rayl
      use rrsw_kg27_f, ka27 => ka, kb27 => kb, sfluxref27 => sfluxref, raylo27=>raylo

      use rrsw_kg28_f, kao28 => kao, kbo28 => kbo, sfluxrefo28 => sfluxrefo
      use rrsw_kg28_f, ka28 => ka, kb28 => kb, sfluxref28 => sfluxref

      use rrsw_kg29_f, kao29 => kao, kbo29 => kbo, selfrefo29 => selfrefo, forrefo29 => forrefo, sfluxrefo29 => sfluxrefo
      use rrsw_kg29_f, absh2oo29 => absh2oo, absco2o29 => absco2o
      use rrsw_kg29_f, ka29 => ka, kb29 => kb, selfref29 => selfref, forref29 => forref, sfluxref29 => sfluxref
      use rrsw_kg29_f, absh2o29 => absh2o, absco229 => absco2

! ------- Declarations

      integer , intent(in) :: ncol
      integer , intent(in) :: gncol                   ! 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
      integer , intent(in) :: iaer
      integer , intent(in) :: dyofyr                  ! Day of the year (used to get Earth/Sun
                                                      !  distance if adjflx not provided)                                                      
      real , intent(in) :: adjes                      ! Flux adjustment for Earth/Sun distance
      real , intent(in) :: scon                       ! Solar constant (W/m2)

      integer , intent(in) :: inflgsw                 ! Flag for cloud optical properties
      integer , intent(in) :: iceflgsw                ! Flag for ice particle specification
      integer , intent(in) :: liqflgsw                ! Flag for liquid droplet specification
      
      real , intent(in) :: gcld(gncol, nlay)          ! Cloud fraction
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gtauc(gncol,nlay,nbndsw)   ! In-cloud optical depth
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: gssac(gncol,nlay,nbndsw)   ! In-cloud single scattering albedo
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: gasmc(gncol,nlay,nbndsw)   ! In-cloud asymmetry parameter
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: gfsfc(gncol,nlay,nbndsw)   ! In-cloud forward scattering fraction
                                                      !    Dimensions: (ncol,nlay,nbndsw)
      real , intent(in) :: gciwp(gncol, nlay)         ! In-cloud ice water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gclwp(gncol, nlay)         ! In-cloud liquid water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gcswp(gncol, nlay)         ! In-cloud snow water path (g/m2)
                                                      !    Dimensions: (ncol,nlay)
                                                      
      real , intent(in) :: grei(gncol, nlay)          ! Cloud ice effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: grel(gncol, nlay)          ! Cloud water drop effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gres(gncol, nlay)          ! Cloud snow drop effective radius (microns)
                                                      !    Dimensions: (ncol,nlay)
                                                      
      
      real , intent(in) :: gplay(gncol,nlay)          ! Layer pressures (hPa, mb)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gplev(gncol,nlay+1)        ! Interface pressures (hPa, mb)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: gtlay(gncol,nlay)          ! Layer temperatures (K)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gtlev(gncol,nlay+1)        ! Interface temperatures (K)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(in) :: gtsfc(gncol)               ! Surface temperature (K)
                                                      !    Dimensions: (ncol)
      real , intent(in) :: gh2ovmr(gncol,nlay)        ! H2O volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: go3vmr(gncol,nlay)         ! O3 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gco2vmr(gncol,nlay)        ! CO2 volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gch4vmr(gncol,nlay)        ! Methane volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gn2ovmr(gncol,nlay)        ! Nitrous oxide volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: go2vmr(gncol,nlay)         ! Oxygen volume mixing ratio
                                                      !    Dimensions: (ncol,nlay)
      real , intent(in) :: gasdir(gncol)              ! UV/vis surface albedo direct rad
                                                      !    Dimensions: (ncol)
      real , intent(in) :: galdir(gncol)              ! Near-IR surface albedo direct rad
                                                      !    Dimensions: (ncol)
      real , intent(in) :: gasdif(gncol)              ! UV/vis surface albedo: diffuse rad
                                                      !    Dimensions: (ncol)
      real , intent(in) :: galdif(gncol)              ! Near-IR surface albedo: diffuse rad
                                                      !    Dimensions: (ncol)

      
      real , intent(in) :: gcoszen(gncol)             ! Cosine of solar zenith angle
                                                      !    Dimensions: (ncol)
    
      real , intent(in) :: gtauaer(gncol,nlay,nbndsw) ! Aerosol optical depth (iaer=10 only)
                                                      !    Dimensions: (ncol,nlay,nbndsw)
                                                      ! (non-delta scaled)      
      real , intent(in) :: gssaaer(gncol,nlay,nbndsw) ! Aerosol single scattering albedo (iaer=10 only)
                                                      !    Dimensions: (ncol,nlay,nbndsw)
                                                      ! (non-delta scaled)      
      real , intent(in) :: gasmaer(gncol,nlay,nbndsw) ! Aerosol asymmetry parameter (iaer=10 only)
                                                      !    Dimensions: (ncol,nlay,nbndsw)
                                                      ! (non-delta scaled)      
      real , intent(in) :: gecaer(:,:,:)              ! Aerosol optical depth at 0.55 micron (iaer=6 only)
                                                      !    Dimensions: (ncol,nlay,naerec)
                                                      ! (non-delta scaled)      
!      integer , intent(in) :: normFlx                 ! Normalize fluxes flag
                                                       ! 0 = no normalization
                                                       ! 1 = normalize fluxes ( / (scon * coszen) )

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

      real , intent(out) :: swuflx(:,:)               ! Total sky shortwave upward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swdflx(:,:)               ! Total sky shortwave downward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swhr(:,:)                 ! Total sky shortwave radiative heating rate (K/d)
                                                      !    Dimensions: (ncol,nlay)
      real , intent(out) :: swuflxc(:,:)              ! Clear sky shortwave upward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swdflxc(:,:)              ! Clear sky shortwave downward flux (W/m2)
                                                      !    Dimensions: (ncol,nlay+1)
      real , intent(out) :: swhrc(:,:)                ! Clear sky shortwave radiative heating rate (K/d)
                                                      !    Dimensions: (ncol,nlay)

      real, intent(out) :: sibvisdir(:,:)              ! visible direct downward flux  (W/m2)
                                                       !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
      real, intent(out) :: sibvisdif(:,:)              ! visible diffusion downward flux  (W/m2)
                                                       !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
      real, intent(out) :: sibnirdir(:,:)              ! Near IR direct downward flux  (W/m2)
                                                       !    Dimensions: (ncol,nlay+1)  Zhenxin (2011/06/20)
      real, intent(out) :: sibnirdif(:,:)              ! Near IR diffusion downward flux  (W/m2)
                                                       !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
      real, intent(out) :: swdkdir(:,:)                ! Total shortwave downward direct flux (W/m2)
                                                       !    Dimensions: (ncol,nlay+1) jararias, 2013/08/10
      real, intent(out) :: swdkdif(:,:)                ! Total shortwave downward diffuse flux (W/m2)
                                                       !    Dimensions: (ncol,nlay+1) jararias, 2013/08/10

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

! Control
     
      integer  :: istart                      ! beginning band of calculation
      integer  :: iend                        ! ending band of calculation
      integer  :: icpr                        ! cldprop/cldprmc use flag
      integer  :: iout                        ! output option flag
  
      integer  :: idelm                       ! delta-m scaling flag
                                              ! [0 = direct and diffuse fluxes are unscaled]
                                              ! [1 = direct and diffuse fluxes are scaled]
                                              ! (total downward fluxes are always delta scaled)
      integer  :: isccos                      ! instrumental cosine response flag (inactive)
      integer  :: iplon                       ! column loop index
      integer  :: i                           ! layer loop index                       ! jk
      integer  :: ib                          ! band loop index                        ! jsw
      integer  :: ia, ig                      ! indices
      integer  :: k                           ! layer loop index
      integer  :: ims                         ! value for changing mcica permute seed
      integer  :: imca                        ! flag for mcica [0=off, 1=on]

      real  :: zepsec, zepzen                 ! epsilon
      real  :: zdpgcp                         ! flux to heating conversion ratio

#ifndef _ACCEL
# define ncol CHNK
#endif

! Atmosphere

      real  :: coldry(ncol,nlay+1)            ! dry air column amount
      real  :: wkl(ncol,mxmol,nlay)           ! molecular amounts (mol/cm-2)

      real  :: cossza(ncol)                   ! Cosine of solar zenith angle
      real  :: adjflux(jpband)                ! adjustment for current Earth/Sun distance
      
                                              !  default value of 1368.22 Wm-2 at 1 AU
      real  :: albdir(ncol,nbndsw)            ! surface albedo, direct          ! zalbp
      real  :: albdif(ncol,nbndsw)            ! surface albedo, diffuse         ! zalbd
      
!      real  :: rdl(ncol), adl(ncol)

! Atmosphere - setcoef
      integer  :: laytrop(ncol)               ! tropopause layer index
      integer  :: layswtch(ncol)              ! tropopause layer index
      integer  :: laylow(ncol)                ! tropopause layer index
      integer  :: jp(ncol,nlay+1)             ! 
      integer  :: jt(ncol,nlay+1)             !
      integer  :: jt1(ncol,nlay+1)            !

      real  :: colh2o(ncol,nlay+1)            ! column amount (h2o)
      real  :: colco2(ncol,nlay+1)            ! column amount (co2)
      real  :: colo3(ncol,nlay+1)             ! column amount (o3)
      real  :: coln2o(ncol,nlay+1)            ! column amount (n2o)
      real  :: colch4(ncol,nlay+1)            ! column amount (ch4)
      real  :: colo2(ncol,nlay+1)             ! column amount (o2)
      real  :: colmol(ncol,nlay+1)            ! column amount
      real  :: co2mult(ncol,nlay+1)           ! column amount 

      integer  :: indself(ncol,nlay+1) 
      integer  :: indfor(ncol,nlay+1) 
      real  :: selffac(ncol,nlay+1) 
      real  :: selffrac(ncol,nlay+1) 
      real  :: forfac(ncol,nlay+1) 
      real  :: forfrac(ncol,nlay+1) 

      real  :: &                              !
                         fac00(ncol,nlay+1) , fac01(ncol,nlay+1) , &
                         fac10(ncol,nlay+1) , fac11(ncol,nlay+1)  
      
      real :: play(ncol,nlay)                 ! Layer pressures (hPa, mb)
                                              !    Dimensions: (ncol,nlay)
      real :: plev(ncol,nlay+1)               ! Interface pressures (hPa, mb)
                                              !    Dimensions: (ncol,nlay+1)
      real :: tlay(ncol,nlay)                 ! Layer temperatures (K)
                                              !    Dimensions: (ncol,nlay)
      real :: tlev(ncol,nlay+1)               ! Interface temperatures (K)
                                              !    Dimensions: (ncol,nlay+1)
      real :: tsfc(ncol)                      ! Surface temperature (K)
                                              !    Dimensions: (ncol)
      real :: coszen(ncol)   

! Atmosphere/clouds - cldprop
      integer  :: ncbands                     ! number of cloud spectral bands

      real   :: cld(ncol,nlay)                ! Cloud fraction
      real   :: tauc(ncol,nlay,nbndsw)        ! In-cloud optical depth
      real   :: ssac(ncol,nlay,nbndsw)        ! In-cloud single scattering 
      real   :: asmc(ncol,nlay,nbndsw)        ! In-cloud asymmetry parameter
      real   :: fsfc(ncol,nlay,nbndsw)        ! In-cloud forward scattering fraction
      real   :: ciwp(ncol,nlay)               ! In-cloud ice water path (g/m2)
      real   :: clwp(ncol,nlay)               ! In-cloud liquid water path (g/m2)
      real   :: cswp(ncol,nlay)               ! In-cloud snow water path (g/m2)
      real   :: rei(ncol,nlay)                ! Cloud ice effective radius (microns)
      real   :: rel(ncol,nlay)                ! Cloud water drop effective radius (microns)
      real   :: res(ncol,nlay)                ! Cloud snow effective radius (microns)
      
      real  :: taucmc(ncol,nlay+1,ngptsw)     ! in-cloud optical depth [mcica]
      real  :: taormc(ncol,nlay+1,ngptsw)     ! unscaled in-cloud optical depth [mcica]
      real  :: ssacmc(ncol,nlay+1,ngptsw)     ! in-cloud single scattering albedo [mcica]
      real  :: asmcmc(ncol,nlay+1,ngptsw)     ! in-cloud asymmetry parameter [mcica]
      real  :: fsfcmc(ncol,nlay+1,ngptsw)     ! in-cloud forward scattering fraction [mcica]
      
      real :: cldfmcl(ncol,nlay+1,ngptsw)     ! cloud fraction [mcica]
      real :: ciwpmcl(ncol,nlay+1,ngptsw)     ! in-cloud ice water path [mcica]
      real :: clwpmcl(ncol,nlay+1,ngptsw)     ! in-cloud liquid water path [mcica]
      real :: cswpmcl(ncol,nlay+1,ngptsw)     ! in-cloud liquid water path [mcica]
                                                     
! Atmosphere/clouds/aerosol - spcvrt,spcvmc
      real  :: ztauc(ncol,nlay+1,nbndsw)      ! cloud optical depth
      real  :: ztaucorig(ncol,nlay+1,nbndsw)  ! unscaled cloud optical depth
      real  :: zasyc(ncol,nlay+1,nbndsw)      ! cloud asymmetry parameter 
                                              !  (first moment of phase function)
      real  :: zomgc(ncol,nlay+1,nbndsw)      ! cloud single scattering albedo
   
      real  :: taua(ncol, nlay+1, nbndsw)
      real  :: asya(ncol, nlay+1, nbndsw)
      real  :: omga(ncol, nlay+1, nbndsw)
   
      real  :: zbbfu(ncol,nlay+2)             ! temporary upward shortwave flux (w/m2)
      real  :: zbbfd(ncol,nlay+2)             ! temporary downward shortwave flux (w/m2)
      real  :: zbbcu(ncol,nlay+2)             ! temporary clear sky upward shortwave flux (w/m2)
      real  :: zbbcd(ncol,nlay+2)             ! temporary clear sky downward shortwave flux (w/m2)
      real  :: zbbfddir(ncol,nlay+2)          ! temporary downward direct shortwave flux (w/m2)
      real  :: zbbcddir(ncol,nlay+2)          ! temporary clear sky downward direct shortwave flux (w/m2)
      real  :: zuvfd(ncol,nlay+2)             ! temporary UV downward shortwave flux (w/m2)
      real  :: zuvcd(ncol,nlay+2)             ! temporary clear sky UV downward shortwave flux (w/m2)
      real  :: zuvfddir(ncol,nlay+2)          ! temporary UV downward direct shortwave flux (w/m2)
      real  :: zuvcddir(ncol,nlay+2)          ! temporary clear sky UV downward direct shortwave flux (w/m2)
      real  :: znifd(ncol,nlay+2)             ! temporary near-IR downward shortwave flux (w/m2)
      real  :: znicd(ncol,nlay+2)             ! temporary clear sky near-IR downward shortwave flux (w/m2)
      real  :: znifddir(ncol,nlay+2)          ! temporary near-IR downward direct shortwave flux (w/m2)
      real  :: znicddir(ncol,nlay+2)          ! temporary clear sky near-IR downward direct shortwave flux (w/m2)

! Optional output fields 
      real  :: swnflx(ncol,nlay+2)            ! Total sky shortwave net flux (W/m2)
      real  :: swnflxc(ncol,nlay+2)           ! Clear sky shortwave net flux (W/m2)
      real  :: dirdflux(ncol,nlay+2)          ! Direct downward shortwave surface flux
      real  :: difdflux(ncol,nlay+2)          ! Diffuse downward shortwave surface flux
      real  :: uvdflx(ncol,nlay+2)            ! Total sky downward shortwave flux, UV/vis  
      real  :: nidflx(ncol,nlay+2)            ! Total sky downward shortwave flux, near-IR 
      real  :: dirdnuv(ncol,nlay+2)           ! Direct downward shortwave flux, UV/vis
      real  :: difdnuv(ncol,nlay+2)           ! Diffuse downward shortwave flux, UV/vis
      real  :: dirdnir(ncol,nlay+2)           ! Direct downward shortwave flux, near-IR
      real  :: difdnir(ncol,nlay+2)           ! Diffuse downward shortwave flux, near-IR
      
      real gpu_device :: zgco(ncol,ngptsw,nlay+1)  , zomco(ncol,ngptsw,nlay+1)  
      real gpu_device :: zrdnd(ncol,ngptsw,nlay+1) 
      real gpu_device :: zref(ncol,ngptsw,nlay+1)  , zrefo(ncol,ngptsw,nlay+1)  
      real gpu_device :: zrefd(ncol,ngptsw,nlay+1) , zrefdo(ncol,ngptsw,nlay+1)  
      real gpu_device :: ztauo(ncol,ngptsw,nlay)  
      real gpu_device :: zdbt(ncol,ngptsw,nlay+1)  , ztdbt(ncol,ngptsw,nlay+1)   
      real gpu_device :: ztra(ncol,ngptsw,nlay+1)  , ztrao(ncol,ngptsw,nlay+1)  
      real gpu_device :: ztrad(ncol,ngptsw,nlay+1) , ztrado(ncol,ngptsw,nlay+1)  
      real gpu_device :: zfd(ncol,ngptsw,nlay+1)   , zfu(ncol,ngptsw,nlay+1)  
      real gpu_device :: zsflxzen(ncol,ngptsw)
      real gpu_device :: ztaur(ncol,nlay,ngptsw)   , ztaug(ncol,nlay,ngptsw) 
#ifndef _ACCEL
# undef ncol
#endif

      integer :: npartc, npart, npartb, cldflag(gncol), profic(gncol), profi(gncol)

      real , parameter :: amd = 28.9660       ! Effective molecular weight of dry air (g/mol)
      real , parameter :: amw = 18.0160       ! Molecular weight of water vapor (g/mol)

! Set molecular weight ratios (for converting mmr to vmr)
!  e.g. h2ovmr = h2ommr * amdw)
      real , parameter :: amdw = 1.607793   ! Molecular weight of dry air / water vapor
      real , parameter :: amdc = 0.658114   ! Molecular weight of dry air / carbon dioxide
      real , parameter :: amdo = 0.603428   ! Molecular weight of dry air / ozone
      real , parameter :: amdm = 1.805423   ! Molecular weight of dry air / methane
      real , parameter :: amdn = 0.658090   ! Molecular weight of dry air / nitrous oxide
      real , parameter :: amdo2 = 0.905140  ! Molecular weight of dry air / oxygen

      real , parameter :: sbc = 5.67e-08    ! Stefan-Boltzmann constant (W/m2K4)
      integer ii,jj,kk,iw
      integer  :: isp, l, ix, n, imol  ! Loop indices
      real  :: amm, summol                      ! 
      real  :: adjflx                           ! flux adjustment for Earth/Sun distance
      integer :: prt
      integer :: piplon
      
      integer :: ipart, cols, cole, colr, ncolc, ncolb
      integer :: irng, cc, ncolst

! Initializations
      
      zepsec = 1.e-06 
      zepzen = 1.e-10 
      oneminus = 1.0  - zepsec
      pi = 2.  * asin(1. )
      irng = 0

      istart = jpb1
      iend = jpb2
      iout = 0
      icpr = 1
      ims = 2
      
      adjflx = adjes
      if (dyofyr .gt. 0) then
         adjflx = earth_sun(dyofyr)
      endif
  
      do ib = jpb1, jpb2
         adjflux(ib) = adjflx * scon / rrsw_scon
      end do

      if (icld.lt.0.or.icld.gt.3) icld = 2
    
      
! determine cloud profile
      cldflag=0
      do iplon = 1, gncol
        if (any(gcld(iplon,:) > 0)) cldflag(iplon)=1
      end do


! build profile separation
      cols = 0
      cole = 0

      do iplon = 1, gncol
        if (cldflag(iplon)==1) then
            cole=cole+1
            profi(cole) = iplon
        else
            cols=cols+1
            profic(cols) = iplon
        end if
      end do
        

!$acc data copyout(swuflxc, swdflxc, swuflx, swdflx, swnflxc, swnflx, swhrc, swhr) &
!$acc create(laytrop, layswtch, laylow, jp, jt, jt1, &
!$acc co2mult, colch4, colco2, colh2o, colmol, coln2o, &
!$acc colo2, colo3, fac00, fac01, fac10, fac11, &
!$acc selffac, selffrac, indself, forfac, forfrac, indfor, &
!$acc zbbfu, zbbfd, zbbcu, zbbcd,zbbfddir, zbbcddir, zuvfd, zuvcd, zuvfddir, &
!$acc zuvcddir, znifd, znicd, znifddir,znicddir, &
!$acc cldfmcl, ciwpmcl, clwpmcl, cswpmcl, &
!$acc taormc, taucmc, ssacmc, asmcmc, fsfcmc) &
!$acc deviceptr(zref,zrefo,zrefd,zrefdo,&
!$acc ztauo,ztdbt,&
!$acc ztra,ztrao,ztrad,ztrado,&
!$acc zfd,zfu,zdbt,zgco,&
!$acc zomco,zrdnd,ztaug, ztaur,zsflxzen)&
!$acc create(ciwp, clwp, cswp, cld, tauc, ssac, asmc, fsfc, rei, rel, res) &
!$acc create(play, tlay, plev, tlev, tsfc, cldflag, coszen) &
!$acc create(coldry, wkl) &
!$acc create(extliq1, ssaliq1, asyliq1, extice2, ssaice2, asyice2) &
!$acc create(extice3, ssaice3, asyice3, fdlice3, abari, bbari, cbari, dbari, ebari, fbari) &
!$acc create(taua, asya, omga,gtauaer,gssaaer,gasmaer) &
!$acc copyin(wavenum2, ngb) &
!$acc copyin(tref, preflog, albdif, albdir, cossza)&
!$acc copyin(icxa, adjflux, nspa, nspb)&
!$acc copyin(kao16,kbo16,selfrefo16,forrefo16,sfluxrefo16)&
!$acc copyin(ka16,kb16,selfref16,forref16,sfluxref16)&
!$acc copyin(kao17,kbo17,selfrefo17,forrefo17,sfluxrefo17)&
!$acc copyin(ka17,kb17,selfref17,forref17,sfluxref17)&
!$acc copyin(kao18,kbo18,selfrefo18,forrefo18,sfluxrefo18)&
!$acc copyin(ka18,kb18,selfref18,forref18,sfluxref18)&
!$acc copyin(kao19,kbo19,selfrefo19,forrefo19,sfluxrefo19)&
!$acc copyin(ka19,kb19,selfref19,forref19,sfluxref19)&
!$acc copyin(kao20,kbo20,selfrefo20,forrefo20,sfluxrefo20,absch4o20)&
!$acc copyin(ka20,kb20,selfref20,forref20,sfluxref20,absch420)&
!$acc copyin(kao21,kbo21,selfrefo21,forrefo21,sfluxrefo21)&
!$acc copyin(ka21,kb21,selfref21,forref21,sfluxref21)&
!$acc copyin(kao22,kbo22,selfrefo22,forrefo22,sfluxrefo22)&
!$acc copyin(ka22,kb22,selfref22,forref22,sfluxref22)&
!$acc copyin(kao23,selfrefo23,forrefo23,sfluxrefo23,raylo23)&
!$acc copyin(ka23,selfref23,forref23,sfluxref23,rayl23)&
!$acc copyin(kao24,kbo24,selfrefo24,forrefo24,sfluxrefo24,abso3ao24,abso3bo24,raylao24,raylbo24)&
!$acc copyin(ka24,kb24,selfref24,forref24,sfluxref24,abso3a24,abso3b24,rayla24,raylb24)&
!$acc copyin(kao25,sfluxrefo25,abso3ao25,abso3bo25,raylo25)&
!$acc copyin(ka25,sfluxref25,abso3a25,abso3b25,rayl25)&
!$acc copyin(sfluxrefo26)&
!$acc copyin(sfluxref26)&
!$acc copyin(kao27,kbo27,sfluxrefo27, raylo27)&
!$acc copyin(ka27,kb27,sfluxref27, rayl27)&
!$acc copyin(kao28,kbo28,sfluxrefo28)&
!$acc copyin(ka28,kb28,sfluxref28,gtauc, gssac, gasmc, gfsfc)&
!$acc copyin(kao29,kbo29,selfrefo29,forrefo29,sfluxrefo29,absh2oo29,absco2o29)&
!$acc copyin(ka29,kb29,selfref29,forref29,sfluxref29,absh2o29,absco229)&
!$acc copyin(gh2ovmr, gco2vmr, go3vmr, gn2ovmr, gch4vmr, go2vmr)&
!$acc copyin(gcld, gciwp, gclwp, gcswp, grei, grel, gres, gplay, gplev, gtlay, gtlev, gtsfc)&
!$acc copyin(gasdir, galdir, gasdif, galdif,profi,profic,gcoszen)&
!$acc copyout(sibvisdir,sibvisdif,sibnirdir,sibnirdif,swdkdir,swdkdif)

!$acc update device(extliq1, ssaliq1, asyliq1, extice2, ssaice2, asyice2) &
!$acc device(extice3, ssaice3, asyice3, fdlice3, abari, bbari, cbari, dbari, ebari, fbari) &
!$acc device(preflog)


      ncolc = cols
      ncolb = cole

      npartc = ceiling( real(ncolc) / real(ncol) )
      npartb = ceiling( real(ncolb) / real(ncol) )


!$acc kernels    
      cldfmcl = 0.0
      ciwpmcl = 0.0
      clwpmcl = 0.0     
      cswpmcl = 0.0     
!$acc end kernels
  
      idelm = 1
      
!$acc kernels
      taua = 0.0
      asya = 0.0
      omga = 1.0
!$acc end kernels

      if (iaer==10) then

!$acc update device(gtauaer,gssaaer,gasmaer)

      end if




! PARTITION LOOP ----------------------------------------------------------------------------
      do cc = 1, 2

        if (cc==1) then 
         
          npart = npartc
          ncolst = ncolc

        else
        
          npart = npartb
          ncolst = ncolb
         
        end if
     
        do ipart = 0,npart-1
!jm call unsetdebug
!jm if (ipart.eq.IDEBUG-1) then
!jm write(0,*)'setting setdebug ipart = ',ipart+1,' npart ',npart
!jm call setdebug
!jm endif
          cols = ipart * ncol + 1
          cole = (ipart + 1) * ncol
          if (cole>ncolst) cole=ncolst
          colr = cole - cols + 1

!$acc kernels            
          taormc = 0.0 
          taucmc = 0.0
          ssacmc = 1.0
          asmcmc = 0.0
          fsfcmc = 0.0
!$acc end kernels            
 
! Clear cases
          if (cc==1) then    
!$acc kernels loop private(piplon)
             do iplon = 1, colr
               piplon = profic(iplon + cols - 1)
     
               do ib=1,8
                 albdir(iplon,ib)  = galdir(piplon)
                 albdif(iplon,ib)  = galdif(piplon)
               enddo
               albdir(iplon,nbndsw)  = galdir(piplon)
               albdif(iplon,nbndsw)  = galdif(piplon)
!  UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron
     
               do ib=10,13
                 albdir(iplon,ib)  = gasdir(piplon)
                 albdif(iplon,ib)  = gasdif(piplon)
               enddo

!  Transition band 9, 12850-16000 cm-1, 0.625-0.778 micron, Take average
               albdir(iplon, 9) = (gasdir(piplon)+galdir(piplon))/2.
               albdif(iplon, 9) = (gasdif(piplon)+galdif(piplon))/2.
             end do
!$acc end kernels      

!$acc kernels 
             do iplon = 1, colr
               piplon = profic(iplon + cols - 1)
               play(iplon,:) = gplay(piplon, 1:nlay)
               plev(iplon,:) = gplev(piplon, 1:nlay+1)
               tlay(iplon,:) = gtlay(piplon, 1:nlay)
               tlev(iplon,:) = gtlev(piplon, 1:nlay+1)
               tsfc(iplon)   = gtsfc(piplon)
             end do
!$acc end kernels

             if (iaer==10) then
!$acc kernels
               do iw=1,nbndsw
               do kk=1,nlay
               do iplon = 1, colr
                 piplon = profic(iplon + cols - 1)
                 taua(iplon, kk, iw) = gtauaer(piplon, kk, iw)
                 asya(iplon, kk, iw) = gasmaer(piplon, kk, iw)
                 omga(iplon, kk, iw) = gssaaer(piplon, kk, iw)
               end do
               end do
               end do
!$acc end kernels
             end if

!$acc kernels
             do iplon = 1, colr
               piplon = profic(iplon + cols - 1)
               wkl(iplon,1,:) = gh2ovmr(piplon,1:nlay)
               wkl(iplon,2,:) = gco2vmr(piplon,1:nlay)
               wkl(iplon,3,:) = go3vmr(piplon,1:nlay)
               wkl(iplon,4,:) = gn2ovmr(piplon,1:nlay)
               wkl(iplon,5,:) = 0.0
               wkl(iplon,6,:) = gch4vmr(piplon,1:nlay)
               wkl(iplon,7,:) = go2vmr(piplon,1:nlay)   
               coszen(iplon)  = gcoszen(piplon)
             end do
!$acc end kernels

!************** cloudy cases ***************
          else   
          
!$acc kernels loop private(piplon)
            do iplon = 1, colr
              piplon = profi(iplon + cols - 1)

              do ib=1,8
                albdir(iplon,ib)  = galdir(piplon)
                albdif(iplon,ib)  = galdif(piplon)
              enddo
              albdir(iplon,nbndsw)  = galdir(piplon)
              albdif(iplon,nbndsw)  = galdif(piplon)

!  UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron
              do ib=10,13
                 albdir(iplon,ib)  = gasdir(piplon)
                 albdif(iplon,ib)  = gasdif(piplon)
              enddo

!  Transition band 9, 12850-16000 cm-1, 0.625-0.778 micron, Take average
              albdir(iplon, 9) = (gasdir(piplon)+galdir(piplon))/2.
              albdif(iplon, 9) = (gasdif(piplon)+galdif(piplon))/2.
            end do
!$acc end kernels               
          
!$acc kernels 
            do iplon = 1, colr
              piplon = profi(iplon + cols - 1)
              play(iplon,:) = gplay(piplon, 1:nlay)
              plev(iplon,:) = gplev(piplon, 1:nlay+1)
              tlay(iplon,:) = gtlay(piplon, 1:nlay)
              tlev(iplon,:) = gtlev(piplon, 1:nlay+1)
              tsfc(iplon) = gtsfc(piplon)
              cld(iplon,:) = gcld(piplon, 1:nlay)
              ciwp(iplon,:) = gciwp(piplon, 1:nlay)
              clwp(iplon,:) = gclwp(piplon, 1:nlay)
              cswp(iplon,:) = gcswp(piplon, 1:nlay)
              rei(iplon,:) = grei(piplon, 1:nlay) 
              rel(iplon,:) = grel(piplon, 1:nlay)
              res(iplon,:) = gres(piplon, 1:nlay)
            end do

!$acc end kernels
            if (iaer==10) then

!$acc kernels    
              do iw=1,nbndsw
              do kk=1,nlay
              do iplon = 1, colr
                piplon = profi(iplon + cols - 1)
                taua(iplon, kk, iw) = gtauaer(piplon, kk, iw)
                asya(iplon, kk, iw) = gasmaer(piplon, kk, iw)
                omga(iplon, kk, iw) = gssaaer(piplon, kk, iw)
              end do
              end do
              end do
!$acc end kernels
            end if


! Copy the direct cloud optical properties over to the temp arrays
! and then onto the GPU
! We are on the CPU here

!$acc kernels 
            do iw=1,nbndsw
            do kk=1,nlay
            do iplon = 1, colr
              piplon = profi(iplon + cols - 1)
              tauc(iplon, kk, iw) = gtauc(piplon, kk, iw)
              ssac(iplon, kk, iw) = gssac(piplon, kk, iw)
              asmc(iplon, kk, iw) = gasmc(piplon, kk, iw)
              fsfc(iplon, kk, iw) = gfsfc(piplon, kk, iw)
            end do
            end do
            end do
!$acc end kernels

!$acc kernels
            do iplon = 1, colr
              piplon = profi(iplon + cols - 1)
              wkl(iplon,1,:) = gh2ovmr(piplon,1:nlay)
              wkl(iplon,2,:) = gco2vmr(piplon,1:nlay)
              wkl(iplon,3,:) = go3vmr(piplon,1:nlay)
              wkl(iplon,4,:) = gn2ovmr(piplon,1:nlay)
              wkl(iplon,5,:) = 0.0
              wkl(iplon,6,:) = gch4vmr(piplon,1:nlay)
              wkl(iplon,7,:) = go2vmr(piplon,1:nlay)  
              coszen(iplon)  = gcoszen(piplon)
            end do
!$acc end kernels
          end if    ! if-else-endif cc=1 (clear and cloudy cases)

!$acc kernels
          cossza = max(zepzen,coszen)
!$acc end kernels  

!$acc kernels
          do iplon = 1,colr
            do l = 1,nlay
              coldry(iplon, l) = (plev(iplon, l)-plev(iplon, l+1)) * 1.e3  * avogad / &
                 (1.e2  * grav * ((1.  - wkl(iplon, 1,l)) * amd + wkl(iplon, 1,l) * amw) * &
                 (1.  + wkl(iplon, 1,l)))
            end do
          end do
!$acc end kernels

!$acc kernels
          do iplon = 1,colr
            do l = 1,nlay
              do imol = 1, nmol
                wkl(iplon,imol,l) = coldry(iplon,l) * wkl(iplon,imol,l)
              end do
            end do
          end do
!$acc end kernels

#ifndef _ACCEL
! Use Tom Henderson's technique to pad out and vector remainder
! with valid data so that we can have a static loop range over 
! columns without having to test for short vectors.
      IF ( colr < CHNK ) THEN

        DO jj = 1,ngptsw
        DO kk = 1,nlay+1
        DO ii = colr+1, CHNK
           taormc(ii,kk,jj) = taormc(colr,kk,jj)
           taucmc(ii,kk,jj) = taucmc(colr,kk,jj)
           ssacmc(ii,kk,jj) = ssacmc(colr,kk,jj)
           asmcmc(ii,kk,jj) = asmcmc(colr,kk,jj)
           fsfcmc(ii,kk,jj) = fsfcmc(colr,kk,jj)
        ENDDO
        ENDDO
        ENDDO
        DO ib = 1,13
        DO ii = colr+1, CHNK
           albdir(ii,ib) = albdir(colr,ib)
           albdif(ii,ib) = albdif(colr,ib)
        ENDDO
        ENDDO
        DO kk = 1,nlay+1
        DO ii = colr+1, CHNK
           plev(ii,kk) = plev(colr,kk)
           tlev(ii,kk) = tlev(colr,kk)
           coldry(ii,kk) = coldry(colr,kk)
        ENDDO
        ENDDO
        DO kk = 1,nlay
        DO ii = colr+1, CHNK
           play(ii,kk) = play(colr,kk)
           tlay(ii,kk) = tlay(colr,kk)
           cld(ii,kk)  = cld(colr,kk)
           ciwp(ii,kk) = ciwp(colr,kk)
           clwp(ii,kk) = clwp(colr,kk)
           cswp(ii,kk) = cswp(colr,kk)
           rei(ii,kk) = rei(colr,kk)
           rel(ii,kk) = rel(colr,kk)
           res(ii,kk) = res(colr,kk)
        ENDDO
        ENDDO
        DO ii = colr+1, CHNK
           tsfc(ii) = tsfc(colr)
        ENDDO
        IF ( iaer==10 ) THEN
         DO jj = 1,nbndsw
         DO kk = 1,nlay+1
         DO ii = colr+1, CHNK
           taua(ii,kk,jj) = taua(colr,kk,jj)
           asya(ii,kk,jj) = asya(colr,kk,jj)
           omga(ii,kk,jj) = omga(colr,kk,jj)
         ENDDO
         ENDDO
         ENDDO
        ENDIF
        DO jj = 1,nbndsw
        DO kk = 1,nlay
        DO ii = colr+1, CHNK
           tauc(ii,kk,jj) = tauc(colr,kk,jj)
           ssac(ii,kk,jj) = ssac(colr,kk,jj)
           asmc(ii,kk,jj) = asmc(colr,kk,jj)
           fsfc(ii,kk,jj) = fsfc(colr,kk,jj)
        ENDDO
        ENDDO
        ENDDO
        DO kk = 1,nlay
        DO jj = 1,mxmol
        DO ii = colr+1, CHNK
           wkl(ii,jj,kk) = wkl(colr,jj,kk)
        ENDDO
        ENDDO
        ENDDO
        DO ii = colr+1, CHNK
           coszen(ii) = coszen(colr)
        ENDDO

      ENDIF
#endif

#ifndef _ACCEL
#  define colr CHNK
#endif

          if (cc==2) then   ! call mcica for cloudy cases
            call mcica_sw(colr, nlay, 112, icld, irng, play, &
                          cld, ciwp, clwp, cswp, tauc, ssac, asmc, fsfc, &
                          cldfmcl, ciwpmcl, clwpmcl, cswpmcl, &
                          taucmc, ssacmc, asmcmc, fsfcmc, 1 ) 
          end if   

          if (cc==2) then   ! call cldprmc for cloudy cases
            call cldprmc_sw(colr, nlay, inflgsw, iceflgsw, liqflgsw,  &
                            cldfmcl, ciwpmcl, clwpmcl, cswpmcl, rei, rel, res, &
                            taormc, taucmc, ssacmc, asmcmc, fsfcmc)
          end if

          call setcoef_sw(colr, nlay, play , tlay , plev , tlev , tsfc , &
                          coldry , wkl , &
                          laytrop, layswtch, laylow, jp , jt , jt1 , &
                          co2mult , colch4 , colco2 , colh2o , colmol , coln2o , &
                          colo2 , colo3 , fac00 , fac01 , fac10 , fac11 , &
                          selffac , selffrac , indself , forfac , forfrac , indfor )

          call spcvmc_sw(cc, ncol, colr, nlay, istart, iend, icpr, idelm, iout, &
                         play, tlay, plev, tlev, &
                         tsfc, albdif, albdir, &
                         cldfmcl, taucmc, asmcmc, ssacmc, taormc, &
                         taua, asya, omga, cossza, coldry, adjflux, &	 
                         laytrop, layswtch, laylow, jp, jt, jt1, &
                         co2mult, colch4, colco2, colh2o, colmol, &
                         coln2o, colo2, colo3, &
                         fac00, fac01, fac10, fac11, &
                         selffac, selffrac, indself, forfac, forfrac, indfor, &
                         zbbfd, zbbfu, zbbcd, zbbcu, zuvfd, &
                         zuvcd, znifd, znicd, &
                         zbbfddir, zbbcddir, zuvfddir, zuvcddir, znifddir, znicddir,&
                         zgco,zomco,zrdnd,zref,zrefo,zrefd,zrefdo,ztauo,zdbt,ztdbt,&
                         ztra,ztrao,ztrad,ztrado,zfd,zfu,ztaug, ztaur, zsflxzen)

#ifndef _ACCEL
#  undef colr
#endif
   
! Transfer up and down, clear and total sky fluxes to output arrays.
! Vertical indexing goes from bottom to top; reverse here for GCM if necessary.

          if (cc==1) then   ! clear
!$acc kernels loop independent
            do iplon = 1, colr
              piplon = profic(iplon + cols - 1)
        
              do i = 1, nlay+1
                swuflxc(piplon,i) = zbbcu(iplon,i) 
                swdflxc(piplon,i) = zbbcd(iplon,i) 
                swuflx(piplon,i) = zbbfu(iplon,i) 
                swdflx(piplon,i) = zbbfd(iplon,i) 

!  All-sky downwward direct and diffuse fluxes
                swdkdir(piplon,i) = zbbfddir(iplon,i)
                swdkdif(piplon,i) = zbbfd(iplon,i) - zbbfddir(iplon,i)
!  UV/visible downward direct/diffuse fluxes
                sibvisdir(piplon,i) = zuvfddir(iplon,i)
                sibvisdif(piplon,i) = zuvfd(iplon,i) - zuvfddir(iplon,i)
!  Near-IR downward direct/diffuse fluxes
                sibnirdir(piplon,i) = znifddir(iplon,i)
                sibnirdif(piplon,i) = znifd(iplon,i) - znifddir(iplon,i)
              enddo

!  Total and clear sky net fluxes

              do i = 1, nlay+1
                swnflxc(iplon,i)  = swdflxc(piplon,i) - swuflxc(piplon,i)
                swnflx(iplon,i)  = swdflx(piplon,i) - swuflx(piplon,i)
              enddo

!  Total and clear sky heating rates

              do i = 1, nlay
                zdpgcp = heatfac / (plev(iplon, i) - plev(iplon, i+1))
                swhrc(piplon,i) = (swnflxc(iplon,i+1)  - swnflxc(iplon,i) ) * zdpgcp
                swhr(piplon,i) = (swnflx(iplon,i+1)  - swnflx(iplon,i) ) * zdpgcp
              enddo
              swhrc(piplon,nlay) = 0. 
              swhr(piplon,nlay) = 0. 
       
! End longitude loop
            enddo
!$acc end kernels 

          else     ! cc = 2, cloudy
!$acc kernels loop independent
            do iplon = 1, colr
              piplon = profi(iplon + cols - 1)

              do i = 1, nlay+1
                swuflxc(piplon,i) = zbbcu(iplon,i) 
                swdflxc(piplon,i) = zbbcd(iplon,i) 
                swuflx(piplon,i) = zbbfu(iplon,i) 
                swdflx(piplon,i) = zbbfd(iplon,i) 

!  All-sky downwward direct and diffuse fluxes
                swdkdir(piplon,i) = zbbfddir(iplon,i)
                swdkdif(piplon,i) = zbbfd(iplon,i) - zbbfddir(iplon,i)
!  UV/visible downward direct/diffuse fluxes
                sibvisdir(piplon,i) = zuvfddir(iplon,i)
                sibvisdif(piplon,i) = zuvfd(iplon,i) - zuvfddir(iplon,i)
!  Near-IR downward direct/diffuse fluxes
                sibnirdir(piplon,i) = znifddir(iplon,i)
                sibnirdif(piplon,i) = znifd(iplon,i) - znifddir(iplon,i)
              enddo

!  Total and clear sky net fluxes

              do i = 1, nlay+1
                swnflxc(iplon,i)  = swdflxc(piplon,i) - swuflxc(piplon,i)
                swnflx(iplon,i)  = swdflx(piplon,i) - swuflx(piplon,i)
              enddo

!  Total and clear sky heating rates

              do i = 1, nlay
                zdpgcp = heatfac / (plev(iplon, i) - plev(iplon, i+1))
                swhrc(piplon,i) = (swnflxc(iplon,i+1)  - swnflxc(iplon,i) ) * zdpgcp
                swhr(piplon,i) = (swnflx(iplon,i+1)  - swnflx(iplon,i) ) * zdpgcp
              enddo
              swhrc(piplon,nlay) = 0. 
              swhr(piplon,nlay) = 0. 
         
! End longitude loop
            enddo
!$acc end kernels 

          end if   ! if-else-endif clear-cloudy

! End partition loops
        end do
        
      end do

!$acc end data

      end subroutine rrtmg_sw_sub

!*************************************************************************
      real  function earth_sun(idn)
!*************************************************************************
!
!  Purpose: Function to calculate the correction factor of Earth's orbit
!  for current day of the year

!  idn        : Day of the year
!  earth_sun  : square of the ratio of mean to actual Earth-Sun distance

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

      use rrsw_con_f, only : pi

      integer , intent(in) :: idn

      real  :: gamma

      gamma = 2. *pi*(idn-1)/365. 

! Use Iqbal's equation 1.2.1

      earth_sun = 1.000110  + .034221  * cos(gamma) + .001289  * sin(gamma) + &
                   .000719  * cos(2. *gamma) + .000077  * sin(2. *gamma)

      end function earth_sun

      end module rrtmg_sw_rad_f

!------------------------------------------------------------------
      MODULE module_ra_rrtmg_swf

      use module_model_constants, only : cp
      USE module_wrf_error
!     USE module_dm

      use parrrsw_f, only : nbndsw, ngptsw, naerec
      use rrtmg_sw_init_f, only: rrtmg_sw_ini
      use rrtmg_sw_rad_f, only: rrtmg_sw
!     use mcica_subcol_gen_sw, only: mcica_subcol_sw

      use module_ra_rrtmg_lwf, only : inirad, o3data, relcalc, reicalc, retab
!                               mcica_random_numbers, randomNumberSequence, &
!                               new_RandomNumberSequence, getRandomReal

      CONTAINS

!------------------------------------------------------------------
      SUBROUTINE RRTMG_SWRAD_FAST(                                &
                       rthratensw,                                &
                       swupt, swuptc, swdnt, swdntc,              &
                       swupb, swupbc, swdnb, swdnbc,              &
!                      swupflx, swupflxc, swdnflx, swdnflxc,      &
                       swcf, gsw,                                 &
                       xtime, gmt, xlat, xlong,                   &
                       radt, degrad, declin,                      &
                       coszr, julday, solcon,                     &
                       albedo, t3d, t8w, tsk,                     &
                       p3d, p8w, pi3d, rho3d,                     &
                       dz8w, cldfra3d, lradius, iradius,          & 
                       is_cammgmp_used, r, g,                     &
                       re_cloud,re_ice,re_snow,                   &
                       has_reqc,has_reqi,has_reqs,                &
                       icloud, warm_rain,                         &
                       f_ice_phy, f_rain_phy,                     &
                       xland, xice, snow,                         &
                       qv3d, qc3d, qr3d,                          &
                       qi3d, qs3d, qg3d,                          &
                       o3input, o33d,                             &
                       aer_opt, aerod, no_src,                    &
                       alswvisdir, alswvisdif,                    &  !Zhenxin ssib alb comp (06/20/2011)
                       alswnirdir, alswnirdif,                    &  !Zhenxin ssib alb comp (06/20/2011)
                       swvisdir, swvisdif,                        &  !Zhenxin ssib swr comp (06/20/2011)
                       swnirdir, swnirdif,                        &  !Zhenxin ssib swi comp (06/20/2011)
                       sf_surface_physics,                        &  !Zhenxin
                       f_qv, f_qc, f_qr, f_qi, f_qs, f_qg,        &
                       tauaer300,tauaer400,tauaer600,tauaer999,   & ! czhao 
                       gaer300,gaer400,gaer600,gaer999,           & ! czhao 
                       waer300,waer400,waer600,waer999,           & ! czhao 
                       aer_ra_feedback,                           &
!jdfcz                 progn,prescribe,                           &
                       progn,                                     &
                       qndrop3d,f_qndrop,                         & !czhao
                       ids,ide, jds,jde, kds,kde,                 & 
                       ims,ime, jms,jme, kms,kme,                 &
                       its,ite, jts,jte, kts,kte,                 &
                       swupflx, swupflxc, swdnflx, swdnflxc,      &
                       tauaer3d_sw,ssaaer3d_sw,asyaer3d_sw,       & ! jararias 2013/11
                       swddir, swddni, swddif,                    & ! jararias 2013/08
                       xcoszen,julian                             & ! jararias 2013/08
                                                                  )
!------------------------------------------------------------------
      IMPLICIT NONE
!------------------------------------------------------------------
   LOGICAL, INTENT(IN )      ::        warm_rain
   LOGICAL, INTENT(IN )      ::   is_CAMMGMP_used ! Added for CAM5 RRTMG<->CAMMGMP
!
   INTEGER, INTENT(IN )      ::        ids,ide, jds,jde, kds,kde, &
                                       ims,ime, jms,jme, kms,kme, &
                                       its,ite, jts,jte, kts,kte

   INTEGER, INTENT(IN )      ::        ICLOUD
!
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         INTENT(IN   ) ::                                   dz8w, &
                                                             t3d, &
                                                             t8w, &
                                                             p3d, &
                                                             p8w, &
                                                            pi3d, &
                                                           rho3d

   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         INTENT(INOUT)  ::                            RTHRATENSW

   REAL, DIMENSION( ims:ime, jms:jme )                          , &
         INTENT(INOUT)  ::                                   GSW, &
                                                            SWCF, &
                                                           COSZR

   INTEGER, INTENT(IN  )     ::                           JULDAY
   REAL, INTENT(IN    )      ::                      RADT,DEGRAD, &
                                         XTIME,DECLIN,SOLCON,GMT

   REAL, DIMENSION( ims:ime, jms:jme )                          , &
         INTENT(IN   )  ::                                  XLAT, &
                                                           XLONG, &
                                                           XLAND, &
                                                            XICE, &
                                                            SNOW, &
                                                             TSK, &
                                                          ALBEDO
!
!!! -------------------  Zhenxin (2011-06/20) ------------------
   REAL, DIMENSION( ims:ime, jms:jme )                          , &
         OPTIONAL                                               , &
         INTENT(IN)     ::                            ALSWVISDIR, &     ! ssib albedo of sw and lw
                                                      ALSWVISDIF, &
                                                      ALSWNIRDIR, &
                                                      ALSWNIRDIF

   REAL, DIMENSION( ims:ime, jms:jme )                          , &
         OPTIONAL                                               , &
         INTENT(OUT)    ::                              SWVISDIR, &
                                                        SWVISDIF, &
                                                        SWNIRDIR, &
                                                        SWNIRDIF        ! ssib sw dir and diff rad
   INTEGER, INTENT(IN) :: sf_surface_physics                            ! ssib para

!  ----------------------- end Zhenxin --------------------------
!

! ------------------------ jararias 2013/08/10 -----------------
   real, dimension(ims:ime,jms:jme), intent(out) :: &
         swddir,  &  ! All-sky broadband surface direct horiz irradiance
         swddni,  &  ! All-sky broadband surface direct normal irradiance
         swddif      ! All-sky broadband surface diffuse irradiance
   real, optional, intent(in) :: &
         julian      ! julian day (1-366)
   real, dimension(ims:ime,jms:jme), optional, intent(in) :: &
         xcoszen     ! cosine of the solar zenith angle
   real, dimension(ims:ime,kms:kme,jms:jme,nbndsw), optional,     &
        intent(in)                                :: tauaer3d_sw, &
                                                     ssaaer3d_sw, &
                                                     asyaer3d_sw
! ------------------------ jararias end snippet -----------------


   REAL, INTENT(IN  )   ::                                   R,G
!
! Optional
!
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         OPTIONAL                                               , &
         INTENT(IN   ) ::                                         &
                                                        CLDFRA3D, &
                                                         LRADIUS, &
                                                         IRADIUS, &
                                                            QV3D, &
                                                            QC3D, &
                                                            QR3D, &
                                                            QI3D, &
                                                            QS3D, &
                                                            QG3D, &
                                                        QNDROP3D

!..Added by G. Thompson to couple cloud physics effective radii.
   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN)::       &
                                                        RE_CLOUD, &
                                                          RE_ICE, &
                                                         RE_SNOW
   INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs

   real pi,third,relconst,lwpmin,rhoh2o

   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         OPTIONAL                                               , &
         INTENT(IN   ) ::                                         &
                                                       F_ICE_PHY, &
                                                      F_RAIN_PHY

   LOGICAL, OPTIONAL, INTENT(IN)   ::                             &
                          F_QV,F_QC,F_QR,F_QI,F_QS,F_QG,F_QNDROP

! Optional
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &
       INTENT(IN    ) :: tauaer300,tauaer400,tauaer600,tauaer999, & ! czhao 
                                 gaer300,gaer400,gaer600,gaer999, & ! czhao 
                                 waer300,waer400,waer600,waer999    ! czhao 

   INTEGER,    INTENT(IN  ), OPTIONAL   ::       aer_ra_feedback
!jdfcz   INTEGER,    INTENT(IN  ), OPTIONAL   ::       progn,prescribe
   INTEGER,    INTENT(IN  ), OPTIONAL   ::       progn
!  Ozone
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &
         OPTIONAL                                               , &
         INTENT(IN   ) :: O33D
   INTEGER, OPTIONAL, INTENT(IN ) :: o3input
!  EC aerosol: no_src = naerec = 6
   INTEGER,           INTENT(IN ) :: no_src
   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:no_src )       , &
         OPTIONAL                                               , &
         INTENT(IN   ) :: aerod
   INTEGER, OPTIONAL, INTENT(IN ) :: aer_opt

!wavelength corresponding to wavenum1 and wavenum2 (cm-1)
   real, save :: wavemin(nbndsw) ! Min wavelength (um) of 14 intervals
   data wavemin /3.077,2.500,2.150,1.942,1.626,1.299, &
   1.242,0.778,0.625,0.442,0.345,0.263,0.200,3.846/
   real, save :: wavemax(nbndsw) ! Max wavelength (um) of interval
   data wavemax/3.846,3.077,2.500,2.150,1.942,1.626, &
   1.299,1.242,0.778,0.625,0.442,0.345,0.263,12.195/
   real wavemid(nbndsw) ! Mid wavelength (um) of interval
   real, parameter :: thresh=1.e-9
   real ang,slope
   character(len=200) :: msg

! Top of atmosphere and surface shortwave fluxes (W m-2)
   REAL, DIMENSION( ims:ime, jms:jme ),                           &
         OPTIONAL, INTENT(INOUT) ::                               &
                                       SWUPT,SWUPTC,SWDNT,SWDNTC, &
                                       SWUPB,SWUPBC,SWDNB,SWDNBC

! Layer shortwave fluxes (including extra layer above model top)
! Vertical ordering is from bottom to top (W m-2)
   REAL, DIMENSION( ims:ime, kms:kme+2, jms:jme ),                &
         OPTIONAL, INTENT(OUT) ::                                 &
                               SWUPFLX,SWUPFLXC,SWDNFLX,SWDNFLXC

!  LOCAL VARS
 
   REAL, DIMENSION( kts:kte+1 ) ::                          Pw1D, &
                                                            Tw1D

   REAL, DIMENSION( kts:kte ) ::                          TTEN1D, &
                                                        CLDFRA1D, &
                                                            DZ1D, &
                                                             P1D, &
                                                             T1D, &
                                                            QV1D, &
                                                            QC1D, &
                                                            QR1D, &
                                                            QI1D, &
                                                            QS1D, &
                                                            QG1D, &
                                                            O31D, &
                                                        qndrop1d 

! Added local arrays for RRTMG
    integer ::                                              ncol, &
                                                            nlay, &
                                                            icld, &
                                                            iaer, &
                                                         inflgsw, &
                                                        iceflgsw, &
                                                        liqflgsw
! Dimension with extra layer from model top to TOA
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+2 )  ::                  plev, &
                                                            tlev
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+1 )  ::                  play, &
                                                            tlay, &
                                                          h2ovmr, &
                                                           o3vmr, &
                                                          co2vmr, &
                                                           o2vmr, &
                                                          ch4vmr, &
                                                          n2ovmr
    real, dimension( kts:kte+1 )  ::                       o3mmr
! Surface albedo (for UV/visible and near-IR spectral regions,
! and for direct and diffuse radiation)
    real, dimension( (jte-jts+1)*(ite-its+1) )  ::                            asdir, &
                                                           asdif, &
                                                           aldir, &
                                                           aldif
! Dimension with extra layer from model top to TOA, 
! though no clouds are allowed in extra layer
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+1 )  ::                clwpth, &
                                                          ciwpth, &
                                                          cswpth, &
                                                             rel, &
                                                             rei, &
                                                             res, &
                                                         cldfrac
!                                                         cldfrac, &
!                                                         relqmcl, &
!                                                         reicmcl, &
!                                                         resnmcl
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+1, nbndsw )  ::        taucld, &
                                                          ssacld, &
                                                          asmcld, &
                                                          fsfcld
!    real, dimension( ngptsw, (jte-jts+1)*(ite-its+1), kts:kte+1 )  ::       cldfmcl, &
!                                                         clwpmcl, &
!                                                         ciwpmcl, &
!                                                         cswpmcl, &
!                                                         taucmcl, &
!                                                         ssacmcl, &
!                                                         asmcmcl, &
!                                                         fsfcmcl
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+1, nbndsw )  ::        tauaer, &
                                                          ssaaer, &
                                                          asmaer   
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+1, naerec )  ::         ecaer

! Output arrays contain extra layer from model top to TOA
    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+2 )  ::                swuflx, &
                                                          swdflx, &
                                                         swuflxc, &
                                                         swdflxc, &
                                                       sibvisdir, &  ! Zhenxin 2011-06-20
                                                       sibvisdif, &
                                                       sibnirdir, &
                                                       sibnirdif     ! Zhenxin 2011-06-20

    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+2 ) ::                swdkdir, &  ! jararias, 2013/08/10
                                                         swdkdif     ! jararias, 2013/08/10

    real, dimension( (jte-jts+1)*(ite-its+1), kts:kte+1 )  ::                  swhr, &
                                                           swhrc

    real, dimension ( (jte-jts+1)*(ite-its+1) ) ::                             tsfc, &
                                                              ps, &
                                                          coszen
    real ::                                                   ro, &
                                                              dz, &
                                                           adjes, &
                                                            scon, &  
                                                snow_mass_factor
    integer ::                                            dyofyr

    integer:: idx_rei
    real:: corr

! Set trace gas volume mixing ratios, 2005 values, IPCC (2007)
! carbon dioxide (379 ppmv)
    real :: co2
    data co2 / 379.e-6 / 
! methane (1774 ppbv)
    real :: ch4
    data ch4 / 1774.e-9 / 
! nitrous oxide (319 ppbv)
    real :: n2o
    data n2o / 319.e-9 / 
! Set oxygen volume mixing ratio (for o2mmr=0.23143)
    real :: o2
    data o2 / 0.209488 /

    integer :: iplon, irng, permuteseed
    integer :: nb

! For old lw cloud property specification
! Cloud and precipitation absorption coefficients
!    real :: abcw,abice,abrn,absn
!    data abcw /0.144/
!    data abice /0.0735/
!    data abrn /0.330e-3/
!    data absn /2.34e-3/

! Molecular weights and ratios for converting mmr to vmr units
!    real :: amd       ! Effective molecular weight of dry air (g/mol)  
!    real :: amw       ! Molecular weight of water vapor (g/mol)        
!    real :: amo       ! Molecular weight of ozone (g/mol)              
!    real :: amo2      ! Molecular weight of oxygen (g/mol)              
! Atomic weights for conversion from mass to volume mixing ratios                
!    data amd   /  28.9660   /                                                  
!    data amw   /  18.0160   /                                                  
!    data amo   /  47.9998   /                                                  
!    data amo2  /  31.9999   /
                                                                                 
    real :: amdw     ! Molecular weight of dry air / water vapor  
    real :: amdo     ! Molecular weight of dry air / ozone
    real :: amdo2    ! Molecular weight of dry air / oxygen
    data amdw /  1.607793 /                                                    
    data amdo /  0.603461 /
    data amdo2 / 0.905190 /
    
!!
    real, dimension((jte-jts+1)*(ite-its+1), 1:kte-kts+1 )  :: pdel          ! Layer pressure thickness (mb)

    real, dimension((jte-jts+1)*(ite-its+1), 1:kte-kts+1) ::   cicewp, &     ! in-cloud cloud ice water path
                                            cliqwp, &     ! in-cloud cloud liquid water path
                                            csnowp, &     ! in-cloud snow water path
                                             reliq, &     ! effective drop radius (microns)
                                             reice        ! ice effective drop size (microns)
    real, dimension((jte-jts+1)*(ite-its+1), 1:kte-kts+1):: recloud1d, &
                                           reice1d, &
                                          resnow1d
    real :: gliqwp, gicewp, gsnowp, gravmks

!
!    REAL   ::  TSFC,GLW0,OLR0,EMISS0,FP
    REAL   ::  FP

!    real, dimension(1:ite-its+1 )          ::   clat     ! latitude in radians for columns
    real :: coszrs                      ! Cosine of solar zenith angle for present latitude 
    logical :: dorrsw                   ! Flag to allow shortwave calculation

    real, dimension ((jte-jts+1)*(ite-its+1)) :: landfrac, landm, snowh, icefrac

    integer :: pcols, pver
    integer :: icol
    integer :: rpart

    REAL :: XT24, TLOCTM, HRANG, XXLAT

    INTEGER :: i,j,K, na
    LOGICAL :: predicate

    REAL :: da, eot ! jararias, 14/08/2013

    integer :: icnt

! mji - write
!    REAL, DIMENSION( ims:ime, jms:jme ) ::         SWDB, SWUT

!------------------------------------------------------------------
#if ( WRF_CHEM == 1 )
      IF ( aer_ra_feedback == 1) then
      IF ( .NOT. &
      ( PRESENT(tauaer300) .AND. &
        PRESENT(tauaer400) .AND. &
        PRESENT(tauaer600) .AND. &
        PRESENT(tauaer999) .AND. &
        PRESENT(gaer300) .AND. &
        PRESENT(gaer400) .AND. &
        PRESENT(gaer600) .AND. &
        PRESENT(gaer999) .AND. &
        PRESENT(waer300) .AND. &
        PRESENT(waer400) .AND. &
        PRESENT(waer600) .AND. &
        PRESENT(waer999) ) ) THEN
      CALL wrf_error_fatal  &
      ('Warning: missing fields required for aerosol radiation' )
      ENDIF
      ENDIF
#endif

! Initial value of number of columns per partition; 
! Use 2 for CPU; for GPU set to 0 here to allow selection
! of appropriate value in rrtmg_sw
#ifdef _ACCEL
      rpart = 0
#else
      rpart = CHNK
#endif


!-----CALCULATE SHORT WAVE RADIATION
!                                                              
! All fields are ordered vertically from bottom to top
! Pressures are in mb

! jararias, 14/08/2013
      if (present(xcoszen)) then
         call wrf_debug(100,'coszen from radiation driver')
      end if

! Number of columns to process
   ncol = (jte-jts+1)*(ite-its+1)

   icnt = 0
! latitude loop
   j_loop: do j = jts,jte

! longitude loop
      i_loop: do i = its,ite
!
         icol = i-its+1 + (j-jts)*(ite-its+1)

! Do shortwave by default, deactivate below if sun below horizon
         dorrsw = .true.

! Cosine solar zenith angle for current time step
!
! xt24 is the fractional part of simulation days plus half of radt expressed in 
! units of minutes
! julian is in days
! radt is in minutes
! jararias, 14/08/2013
         if (present(xcoszen)) then
            coszr(i,j)=xcoszen(i,j)
            coszrs=xcoszen(i,j)
         else
!            da=6.2831853071795862*(julian-1)/365.
!            eot=(0.000075+0.001868*cos(da)-0.032077*sin(da) &
!               -0.014615*cos(2*da)-0.04089*sin(2*da))*(229.18)
            xt24 = mod(xtime+radt*0.5,1440.)+eot
            tloctm = gmt + xt24/60. + xlong(i,j)/15.
            hrang = 15. * (tloctm-12.) * degrad
            xxlat = xlat(i,j) * degrad
            coszrs = sin(xxlat) * sin(declin) &
                   + cos(xxlat) * cos(declin) * cos(hrang)
            coszr(i,j) = coszrs
         end if

! mji - count daytime points to not process fully nighttime scenes
         if (coszrs .gt. 0.0) icnt = icnt + 1

! Set flag to prevent shortwave calculation when sun below horizon
! mji - must set up input everywhere to run model at all grid points on
!       GPU when any daytime points present 
!         if (coszrs.le.0.0) dorrsw = .false.

! Perform shortwave calculation if sun above horizon
         if (dorrsw) then

         do k=kts,kte+1
            Pw1D(K) = p8w(I,K,J)/100.
            Tw1D(K) = t8w(I,K,J)
         enddo

         DO K=kts,kte
            QV1D(K)=0.
            QC1D(K)=0.
            QR1D(K)=0.
            QI1D(K)=0.
            QS1D(K)=0.
            CLDFRA1D(k)=0.
            QNDROP1D(k)=0.
         ENDDO

         DO K=kts,kte
            QV1D(K)=QV3D(I,K,J)
            QV1D(K)=max(0.,QV1D(K))
         ENDDO

         IF (PRESENT(O33D)) THEN
            DO K=kts,kte
               O31D(K)=O33D(I,K,J)
            ENDDO
         ELSE
            DO K=kts,kte
               O31D(K)=0.0
            ENDDO
         ENDIF

         DO K=kts,kte
            TTEN1D(K)=0.
            T1D(K)=t3d(I,K,J)
            P1D(K)=p3d(I,K,J)/100.
            DZ1D(K)=dz8w(I,K,J)
         ENDDO

! moist variables

         IF (ICLOUD .ne. 0) THEN
            IF ( PRESENT( CLDFRA3D ) ) THEN
              DO K=kts,kte
                 CLDFRA1D(k)=CLDFRA3D(I,K,J)
              ENDDO
            ENDIF

            IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
              IF ( F_QC) THEN
                 DO K=kts,kte
                    QC1D(K)=QC3D(I,K,J)
                    QC1D(K)=max(0.,QC1D(K))
                 ENDDO
              ENDIF
            ENDIF

            IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
              IF ( F_QR) THEN
                 DO K=kts,kte
                    QR1D(K)=QR3D(I,K,J)
                    QR1D(K)=max(0.,QR1D(K))
                 ENDDO
              ENDIF
            ENDIF

            IF ( PRESENT(F_QNDROP).AND.PRESENT(QNDROP3D)) THEN
             IF (F_QNDROP) THEN
              DO K=kts,kte
               qndrop1d(K)=qndrop3d(I,K,J)
              ENDDO
             ENDIF
            ENDIF

! This logic is tortured because cannot test F_QI unless
! it is present, and order of evaluation of expressions
! is not specified in Fortran

            IF ( PRESENT ( F_QI ) ) THEN
              predicate = F_QI
            ELSE
              predicate = .FALSE.
            ENDIF

! For MP option 3
            IF (.NOT. predicate .and. .not. warm_rain) THEN
               DO K=kts,kte
                  IF (T1D(K) .lt. 273.15) THEN
                  QI1D(K)=QC1D(K)
                  QS1D(K)=QR1D(K)
                  QC1D(K)=0.
                  QR1D(K)=0.
                  ENDIF
               ENDDO
            ENDIF

            IF (PRESENT(F_QI) .AND. PRESENT(QI3D)) THEN
               IF (F_QI) THEN
                  DO K=kts,kte
                     QI1D(K)=QI3D(I,K,J)
                     QI1D(K)=max(0.,QI1D(K))
                  ENDDO
               ENDIF
            ENDIF

            IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
               IF (F_QS) THEN
                  DO K=kts,kte
                     QS1D(K)=QS3D(I,K,J)
                     QS1D(K)=max(0.,QS1D(K))
                  ENDDO
               ENDIF
            ENDIF

            IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
               IF (F_QG) THEN
                  DO K=kts,kte
                     QG1D(K)=QG3D(I,K,J)
                     QG1D(K)=max(0.,QG1D(K))
                  ENDDO
               ENDIF
            ENDIF

! mji - For MP option 5
            IF ( PRESENT(F_QI) .and. PRESENT(F_QC) .and. PRESENT(F_QS) .and. PRESENT(F_ICE_PHY) ) THEN
               IF ( F_QC .and. .not. F_QI .and. F_QS ) THEN
                  DO K=kts,kte
                     qi1d(k) = 0.1*qs3d(i,k,j)
                     qs1d(k) = 0.9*qs3d(i,k,j)
                     qc1d(k) = qc3d(i,k,j)
                     qi1d(k) = max(0.,qi1d(k))
                     qc1d(k) = max(0.,qc1d(k))
                  ENDDO
               ENDIF
            ENDIF

         ENDIF

!         EMISS0=EMISS(I,J)
!         GLW0=0. 
!         OLR0=0. 
!         TSFC=TSK(I,J)
         DO K=kts,kte
            QV1D(K)=AMAX1(QV1D(K),1.E-12) 
         ENDDO

! Set up input for shortwave
!         ncol = 1
! Add extra layer from top of model to top of atmosphere
         nlay = (kte - kts + 1) + 1

! Select cloud liquid and ice optics parameterization options
! For passing in cloud optical properties directly:
!         icld = 2
!         inflgsw = 0
!         iceflgsw = 0
!         liqflgsw = 0
! For passing in cloud physical properties; cloud optics parameterized in RRTMG:
         icld = 2
         inflgsw = 2
         iceflgsw = 3
         liqflgsw = 1

!Mukul change the flags here with reference to the new effective cloud/ice/snow radius
         IF (ICLOUD .ne. 0) THEN
            IF ( has_reqc .ne. 0) THEN
               inflgsw = 3
               DO K=kts,kte
                  recloud1D(icol,K) = MAX(2.5, re_cloud(I,K,J)*1.E6)
                  if (recloud1D(icol,K).LE.2.5.AND.cldfra3d(i,k,j).gt.0. &
     &                            .AND. (XLAND(I,J)-1.5).GT.0.) then      !--- Ocean
                     recloud1D(icol,K) = 10.5
                  elseif (recloud1D(icol,K).LE.2.5.AND.cldfra3d(i,k,j).gt.0. &
     &                            .AND. (XLAND(I,J)-1.5).LT.0.) then      !--- Land
                     recloud1D(icol,K) = 7.5
                  endif
               ENDDO
            ELSE
               DO K=kts,kte
                  recloud1D(icol,K) = 5.0
               ENDDO
            ENDIF

            IF ( has_reqi .ne. 0) THEN
               inflgsw  = 4
               iceflgsw = 4
               DO K=kts,kte
                  reice1D(icol,K) = MAX(10., re_ice(I,K,J)*1.E6)
                  if (reice1D(icol,K).LE.10..AND.cldfra3d(i,k,j).gt.0.) then
                     idx_rei = int(t3d(i,k,j)-179.)
                     idx_rei = min(max(idx_rei,1),75)
                     corr = t3d(i,k,j) - int(t3d(i,k,j))
                     reice1D(icol,K) = retab(idx_rei)*(1.-corr) +      &
     &                                 retab(idx_rei+1)*corr
                     reice1D(icol,K) = MAX(reice1D(icol,K), 10.0)
                  endif
               ENDDO
            ELSE
               DO K=kts,kte
                  reice1D(icol,K) = 10.0
               ENDDO
            ENDIF

            IF ( has_reqs .ne. 0) THEN
               inflgsw  = 5
               iceflgsw = 5
               DO K=kts,kte
                  resnow1D(icol,K) = MAX(10., re_snow(I,K,J)*1.E6)
               ENDDO
            ELSE
               DO K=kts,kte
                  resnow1D(icol,K) = 10.
               ENDDO
            ENDIF
         ENDIF

! Set cosine of solar zenith angle
         coszen(icol) = coszrs
! Set solar constant
         scon = solcon
! For Earth/Sun distance adjustment in RRTMG
!         dyofyr = julday
!         adjes = 0.0 
! For WRF, solar constant is already provided with eccentricity adjustment,
! so do not do this in RRTMG
         dyofyr = 0
         adjes = 1.0 

! Layer indexing goes bottom to top here for all fields.
! Water vapor and ozone are converted from mmr to vmr. 
! Pressures are in units of mb here. 
         plev(icol,1) = pw1d(1)
         tlev(icol,1) = tw1d(1)
         tsfc(icol) = tsk(i,j)
         do k = kts, kte
            play(icol,k) = p1d(k)
            plev(icol,k+1) = pw1d(k+1)
            pdel(icol,k) = plev(icol,k) - plev(icol,k+1)
            tlay(icol,k) = t1d(k)
            tlev(icol,k+1) = tw1d(k+1)
            h2ovmr(icol,k) = qv1d(k) * amdw
            co2vmr(icol,k) = co2
            o2vmr(icol,k) = o2
            ch4vmr(icol,k) = ch4
            n2ovmr(icol,k) = n2o
         enddo

!  Define profile values for extra layer from model top to top of atmosphere. 
!  The top layer temperature for all gridpoints is set to the top layer-1 
!  temperature plus a constant (0 K) that represents an isothermal layer    
!  above ptop.  Top layer interface temperatures are linearly interpolated 
!  from the layer temperatures.  

         play(icol,kte+1) = 0.5 * plev(icol,kte+1)
         tlay(icol,kte+1) = tlev(icol,kte+1) + 0.0
         plev(icol,kte+2) = 1.0e-5
         tlev(icol,kte+2) = tlev(icol,kte+1) + 0.0
         tlev(icol,kte+2) = tlev(icol,kte+1) + 0.0
         h2ovmr(icol,kte+1) = h2ovmr(icol,kte) 
         co2vmr(icol,kte+1) = co2vmr(icol,kte) 
         o2vmr(icol,kte+1) = o2vmr(icol,kte) 
         ch4vmr(icol,kte+1) = ch4vmr(icol,kte) 
         n2ovmr(icol,kte+1) = n2ovmr(icol,kte) 

! Get ozone profile including amount in extra layer above model top
!         call inirad (o3mmr,plev,kts,kte)
         call inirad (o3mmr,plev(icol,:),kts,kte)

        if(present(o33d)) then
         do k = kts, kte+1
            o3vmr(icol,k) = o3mmr(k) * amdo
            IF ( PRESENT( O33D ) ) THEN
            if(o3input .eq. 2)then
               if(k.le.kte)then
                 o3vmr(icol,k) = o31d(k)
               else
! apply shifted climatology profile above model top
                 o3vmr(icol,k) = o31d(kte) - o3mmr(kte)*amdo + o3mmr(k)*amdo
                 if(o3vmr(icol,k) .le. 0.)o3vmr(icol,k) = o3mmr(k)*amdo
               endif
            endif
            ENDIF
         enddo
        else
         do k = kts, kte+1
            o3vmr(icol,k) = o3mmr(k) * amdo
         enddo
        endif

! Set surface albedo for direct and diffuse radiation in UV/visible and
! near-IR spectral regions
! -------------- Zhenxin 2011-06-20 ----------- !

! ------- 1.  Commented by Zhenxin 2011-06-20 for SSiB coupling modified ---- !
!         asdir(icol) = albedo(i,j)
!         asdif(icol) = albedo(i,j)
!         aldir(icol) = albedo(i,j)
!         aldif(icol) = albedo(i,j)
! -------    End of Comments    ------ !

! ------- 2. New Addition  ------ !
    IF ( sf_surface_physics .eq. 8 .AND. XLAND(i,j) .LT. 1.5) THEN
         asdir(icol) = ALSWVISDIR(I,J)
         asdif(icol) = ALSWVISDIF(I,J)
         aldir(icol) = ALSWNIRDIR(I,J)
         aldif(icol) = ALSWNIRDIF(I,J)
    ELSE
         asdir(icol) = albedo(i,j)
         asdif(icol) = albedo(i,j)
         aldir(icol) = albedo(i,j)
         aldif(icol) = albedo(i,j)
    ENDIF

! ---------- End of Addition ------!
! ----------  End of fds_Zhenxin 2011-06-20   --------------!

! Define cloud optical properties for radiation (inflgsw = 0)
! This option is not currently active
! Cloud and precipitation paths in g/m2 
! qi=0 if no ice phase
! qs=0 if no ice phase
         if (inflgsw .eq. 0) then

! Set cloud fraction and cloud optical properties here; not yet active
            do k = kts, kte
               cldfrac(icol,k) = cldfra1d(k)
               do nb = 1, nbndsw
                  taucld(icol,k,nb) = 0.0
                  ssacld(icol,k,nb) = 1.0
                  asmcld(icol,k,nb) = 0.0
                  fsfcld(icol,k,nb) = 0.0
               enddo
            enddo

! Zero out cloud physical property arrays; not used when passing optical properties
! into radiation
            do k = kts, kte
               clwpth(icol,k) = 0.0
               ciwpth(icol,k) = 0.0
               rel(icol,k) = 10.0
               rei(icol,k) = 10.
            enddo
         endif

! Define cloud physical properties for radiation (inflgsw = 1 or 2)
! Cloud fraction
! Set cloud arrays if passing cloud physical properties into radiation
         if (inflgsw .gt. 0) then 
            do k = kts, kte
               cldfrac(icol,k) = cldfra1d(k)
            enddo

! Compute cloud water/ice paths and particle sizes for input to radiation (CAM method)
            pcols = ncol
            pver = kte - kts + 1
            gravmks = g
            landfrac(icol) = 2.-XLAND(I,J)
            landm(icol) = landfrac(icol)
            snowh(icol) = 0.001*SNOW(I,J)
            icefrac(icol) = XICE(I,J)

! From module_ra_cam: Convert liquid and ice mixing ratios to water paths;
! pdel is in mb here; convert back to Pa (*100.)
! Water paths are in units of g/m2
! snow added as ice cloud (JD 091022)
            do k = kts, kte
               gicewp = (qi1d(k)+qs1d(k)) * pdel(icol,k)*100.0 / gravmks * 1000.0     ! Grid box ice water path.
               gliqwp = qc1d(k) * pdel(icol,k)*100.0 / gravmks * 1000.0     ! Grid box liquid water path.
               cicewp(icol,k) = gicewp / max(0.01,cldfrac(icol,k))               ! In-cloud ice water path.
               cliqwp(icol,k) = gliqwp / max(0.01,cldfrac(icol,k))               ! In-cloud liquid water path.
            end do

! Mukul
!..The ice water path is already sum of cloud ice and snow, but when we have explicit
!.. ice effective radius, overwrite the ice path with only the cloud ice variable,
!.. leaving out the snow for its own effect.
           if(iceflgsw.ge.4)then 
              do k = kts, kte
                     gicewp = qi1d(k) * pdel(icol,k)*100.0 / gravmks * 1000.0     ! Grid box ice water path.
                     cicewp(icol,k) = gicewp / max(0.01,cldfrac(icol,k))               ! In-cloud ice water path.
              end do
           end if

!..Here the snow path is adjusted if (radiation) effective radius of snow is
!.. larger than what we currently have in the lookup tables.  Since mass goes
!.. rather close to diameter squared, adjust the mixing ratio of snow used
!.. to compute its water path in combination with the max diameter.  Not a
!.. perfect fix, but certainly better than using all snow mass when diameter is
!.. far larger than table currently contains and crystal sizes much larger than
!.. about 140 microns have lesser impact than those much smaller sizes.

           if(iceflgsw.eq.5)then
              do k = kts, kte
                 snow_mass_factor = 1.0                 
                 if (resnow1d(icol,k) .gt. 130.)then 
                     snow_mass_factor = (130.0/resnow1d(icol,k))*(130.0/resnow1d(icol,k))
                     resnow1d(icol,k)   = 130.0
                 endif
                 gsnowp = qs1d(k) * snow_mass_factor * pdel(icol,k)*100.0 / gravmks * 1000.0     ! Grid box snow water path.
                 csnowp(icol,k) = gsnowp / max(0.01,cldfrac(icol,k))
              end do
           end if


!link the aerosol feedback to cloud  -czhao
  if( PRESENT( progn ) ) then
    if (progn == 1) then
!jdfcz     if(prescribe==0) then

      pi = 4.*atan(1.0)
      third=1./3.
      rhoh2o=1.e3
      relconst=3/(4.*pi*rhoh2o)
!     minimun liquid water path to calculate rel
!     corresponds to optical depth of 1.e-3 for radius 4 microns.
      lwpmin=3.e-5
      do k = kts, kte
         reliq(icol,k) = 10.
         if( PRESENT( F_QNDROP ) ) then
            if( F_QNDROP ) then
              if ( qc1d(k)*pdel(icol,k).gt.lwpmin.and. &
                   qndrop1d(k).gt.1000. ) then
               reliq(icol,k)=(relconst*qc1d(k)/qndrop1d(k))**third ! effective radius in m
!           apply scaling from Martin et al., JAS 51, 1830.
               reliq(icol,k)=1.1*reliq(icol,k)
               reliq(icol,k)=reliq(icol,k)*1.e6 ! convert from m to microns
               reliq(icol,k)=max(reliq(icol,k),4.)
               reliq(icol,k)=min(reliq(icol,k),20.)
              end if
            end if
         end if
      end do
!jdfcz     else ! prescribe 
! following Kiehl
!      call relcalc(icol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
!      write(0,*) 'sw prescribe aerosol',maxval(qndrop3d)
!jdfcz     endif
    else  ! progn   (progn=1)
      call relcalc(icol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
    endif
  else   !progn   (PRESENT)
      call relcalc(icol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
  endif

! following Kristjansson and Mitchell
      call reicalc(icol, pcols, pver, tlay, reice)



!..If we already have effective radius of cloud and ice, then just overwrite what
!.. was computed in the relcalc and reicalc subroutines above.

      if (inflgsw .ge. 3) then
         do k = kts, kte
            reliq(icol,k) = recloud1d(icol,k)
         end do
      endif
      if (iceflgsw .ge. 4) then
         do k = kts, kte
            reice(icol,k) = reice1d(icol,k)
         end do
      endif


! Limit upper bound of reice for Fu ice parameterization and convert
! from effective radius to generalized effective size (*1.0315; Fu, 1996)
            if (iceflgsw .eq. 3) then
               do k = kts, kte
                  reice(icol,k) = reice(icol,k) * 1.0315
                  reice(icol,k) = min(140.0,reice(icol,k))
               end do
            endif

!if CAMMGMP is used, use output from CAMMGMP            
!PMA
            if(is_CAMMGMP_used) then
               do k = kts, kte
                  if ( qi1d(k) .gt. 1.e-20 .or. qs1d(k) .gt. 1.e-20) then
                     reice(icol,k) = iradius(i,k,j)
                  else
                     reice(icol,k) = 25.
                  end if
                  reice(icol,k) = max(5., min(140.0,reice(icol,k)))
                  if ( qc1d(k) .gt. 1.e-20) then
                     reliq(icol,k) = lradius(i,k,j)
                  else
                     reliq(icol,k) = 10.
                  end if
                  reliq(icol,k) = max(2.5, min(60.0,reliq(icol,k)))
               enddo
            endif

! Set cloud physical property arrays
            do k = kts, kte
               clwpth(icol,k) = cliqwp(icol,k)
               ciwpth(icol,k) = cicewp(icol,k)
               rel(icol,k) = reliq(icol,k)
               rei(icol,k) = reice(icol,k)
            enddo

!Mukul
            if (inflgsw .eq. 5) then
               do k = kts, kte
                  cswpth(icol,k) = csnowp(icol,k)
                  res(icol,k) = resnow1d(icol,k)
               end do
            else
               do k = kts, kte
                  cswpth(icol,k) = 0.0
                  res(icol,k) = 10.0
               end do
            endif

! Zero out cloud optical properties here, calculated in radiation 
            do k = kts, kte
               do nb = 1, nbndsw
                  taucld(icol,k,nb) = 0.0
                  ssacld(icol,k,nb) = 1.0
                  asmcld(icol,k,nb) = 0.0
                  fsfcld(icol,k,nb) = 0.0
               enddo
            enddo
         endif

! No clouds are allowed in the extra layer from model top to TOA
         clwpth(icol,kte+1) = 0.
         ciwpth(icol,kte+1) = 0.
         cswpth(icol,kte+1) = 0.
         rel(icol,kte+1) = 10.
         rei(icol,kte+1) = 10.
         res(icol,kte+1) = 10.
         cldfrac(icol,kte+1) = 0.
         do nb = 1, nbndsw
            taucld(icol,kte+1,nb) = 0.
            ssacld(icol,kte+1,nb) = 1.
            asmcld(icol,kte+1,nb) = 0.
            fsfcld(icol,kte+1,nb) = 0.
         enddo

! mji - mcica sub-column generator called inside rrtmg_sw for gpu
!         iplon = 1
!         irng = 0
!         permuteseed = 1
! Sub-column generator for McICA
!         call mcica_subcol_sw(iplon, icol, nlay, icld, permuteseed, irng, play, &
!                       cldfrac, ciwpth, clwpth, cswpth, rei, rel, res, taucld, ssacld, asmcld, fsfcld, &
!                       cldfmcl, ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, resnmcl, &
!                       taucmcl, ssacmcl, asmcmcl, fsfcmcl)

!--------------------------------------------------------------------------
! Aerosol optical depth, single scattering albedo and asymmetry parameter -czhao 03/2010
!--------------------------------------------------------------------------
! by layer for each RRTMG shortwave band
! No aerosols in top layer above model top (kte+1).
!cz        do nb = 1, nbndsw
!cz           do k = kts, kte+1
!cz              tauaer(icol,k,nb) = 0.
!cz              ssaaer(icol,k,nb) = 1.
!cz              asmaer(icol,k,nb) = 0.
!cz           enddo
!cz        enddo

! ... Aerosol effects. Added aerosol feedbacks from Chem , 03/2010 -czhao
!
      do nb = 1, nbndsw
      do k = kts,kte+1
         tauaer(icol,k,nb) = 0.
         ssaaer(icol,k,nb) = 1.
         asmaer(icol,k,nb) = 0.
      end do
      end do

      if ( present (tauaer3d_sw) ) then
! ---- jararias 11/2012
         if ( aer_opt .eq. 2) then
            do nb=1,nbndsw
               do k=kts,kte
                  tauaer(icol,k,nb)=tauaer3d_sw(i,k,j,nb)
                  ssaaer(icol,k,nb)=ssaaer3d_sw(i,k,j,nb)
                  asmaer(icol,k,nb)=asyaer3d_sw(i,k,j,nb)
               end do
            end do
         end if
      end if

#if ( WRF_CHEM == 1 )
   IF ( AER_RA_FEEDBACK == 1) then
      do nb = 1, nbndsw
         wavemid(nb)=0.5*(wavemin(nb)+wavemax(nb))  ! um
      do k = kts,kte      !wig

! convert optical properties at 300,400,600, and 999 to conform to the band wavelengths
! tauaer - use angstrom exponent
        if(tauaer300(i,k,j).gt.thresh .and. tauaer999(i,k,j).gt.thresh) then
           ang=alog(tauaer300(i,k,j)/tauaer999(i,k,j))/alog(999./300.)
           tauaer(icol,k,nb)=tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
           !tauaer(icol,k,nb)=tauaer600(i,k,j)*(0.6/wavemid(nb))**ang 
!jm TODO need to fix these so they are not writing to stderr, stdout 20141218
           if (i==30.and.j==49.and.k==2.and.nb==12) then
            write(0,*) 'TAU from 600 vs 400 in RRTMG',tauaer600(i,k,j),tauaer400(i,k,j)
            print*, 'TAU from 600 vs 400 in RRTMG',tauaer600(i,k,j),tauaer400(i,k,j)
            write(0,*) tauaer600(i,k,j)*(0.6/wavemid(nb))**ang,tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
            print*, tauaer600(i,k,j)*(0.6/wavemid(nb))**ang,tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
           endif
! ssa - linear interpolation; extrapolation
           slope=(waer600(i,k,j)-waer400(i,k,j))/.2
           ssaaer(icol,k,nb) = slope*(wavemid(nb)-.6)+waer600(i,k,j)
           if(ssaaer(icol,k,nb).lt.0.4) ssaaer(icol,k,nb)=0.4
           if(ssaaer(icol,k,nb).ge.1.0) ssaaer(icol,k,nb)=1.0
! g - linear interpolation;extrapolation
           slope=(gaer600(i,k,j)-gaer400(i,k,j))/.2
           asmaer(icol,k,nb) = slope*(wavemid(nb)-.6)+gaer600(i,k,j) ! notice reversed varaibles
           if(asmaer(icol,k,nb).lt.0.5) asmaer(icol,k,nb)=0.5
           if(asmaer(icol,k,nb).ge.1.0) asmaer(icol,k,nb)=1.0
        endif
      end do ! k
      end do ! nb

!wig beg
      do nb = 1, nbndsw
         slope = 0.  !use slope as a sum holder
         do k = kts,kte
            slope = slope + tauaer(icol,k,nb)
         end do
         if( slope < 0. ) then
            write(msg,'("ERROR: Negative total optical depth of ",f8.2,&
             " at point i,j,nb=",3i5)') slope,i,j,nb
            call wrf_error_fatal(msg)
         else if( slope > 6. ) then
            call wrf_message("-------------------------")
            write(msg,'("WARNING: Large total sw optical depth of ",f8.2,&
             " at point i,j,nb=",3i5)') slope,i,j,nb
            call wrf_message(msg)

            call wrf_message("Diagnostics 1: k, tauaer300, tauaer400,&
               tauaer600, tauaer999, tauaer")
            do k=kts,kte
               write(msg,'(i4,5f8.2)') k, tauaer300(i,k,j), tauaer400(i,k,j), &
                    tauaer600(i,k,j), tauaer999(i,k,j),tauaer(icol,k,nb)
               call wrf_message(msg)
               !czhao set an up-limit here to avoid segmentation fault 
               !from extreme AOD
               tauaer(icol,k,nb)=tauaer(icol,k,nb)*6.0/slope 
            end do

            call wrf_message("Diagnostics 2: k, gaer300, gaer400, gaer600,&
               gaer999")
            do k=kts,kte
               write(msg,'(i4,4f8.2)') k, gaer300(i,k,j), gaer400(i,k,j), &
                    gaer600(i,k,j), gaer999(i,k,j)
               call wrf_message(msg)
            end do

            call wrf_message("Diagnostics 3: k, waer300, waer400, waer600,&
               waer999")
            do k=kts,kte
               write(msg,'(i4,4f8.2)') k, waer300(i,k,j), waer400(i,k,j), &
                    waer600(i,k,j), waer999(i,k,j)
               call wrf_message(msg)
            end do

            call wrf_message("Diagnostics 4: k, ssaal, asyal, taual")
            do k=kts-1,kte
               write(msg,'(i4,3f8.2)') k, ssaaer(i,k,nb), asmaer(i,k,nb), tauaer(i,k,nb)
               call wrf_message(msg)
            end do
            call wrf_message("-------------------------")
         endif
      enddo  ! nb
      endif  ! aer_ra_feedback
#endif


! Zero array for input of aerosol optical thickness for use with
! ECMWF aerosol types (not used)
      iaer = 0
      do na = 1, naerec
         do k = kts, kte+1
            ecaer(icol,k,na) = 0.
         enddo
      enddo

      IF ( PRESENT( aerod ) ) THEN
      if ( aer_opt .eq. 0 .or. aer_opt .eq. 2 ) then
         iaer = 10
         do na = 1, naerec
            do k = kts, kte+1
               ecaer(icol,k,na) = 0.
            enddo
         enddo
      else if ( aer_opt .eq. 1 ) then
         iaer = 6
         do na = 1, naerec
            do k = kts, kte
               ecaer(icol,k,na) = aerod(i,k,j,na)
            enddo
! assuming 0 or same value at the top?
!           ecaer(icol,kte+1,na) = ecaer(icol,kte,na)
            ecaer(icol,kte+1,na) = 0.
         enddo
      endif
      ENDIF
!
! End of dorrsw check
      endif
! End of grid loops
      enddo i_loop
   enddo j_loop                                           

! Call RRTMG shortwave radiation model
! Perform shortwave calculation if sun above horizon in any part of grid
! Do not perform shortwave calculations if all of grid is in darkness
      if (icnt .eq. 0) dorrsw = .false.
      if (dorrsw) then

         call rrtmg_sw &
            (rpart   ,ncol    ,nlay    ,icld    ,iaer   , &
             play    ,plev    ,tlay    ,tlev    ,tsfc   , &
             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr ,o2vmr , &
             asdir   ,asdif   ,aldir   ,aldif   , &
             coszen  ,adjes   ,dyofyr  ,scon    , &
             inflgsw ,iceflgsw,liqflgsw,cldfrac , &
             taucld  ,ssacld  ,asmcld  ,fsfcld  , &
             ciwpth  ,clwpth  ,cswpth  ,rei     ,rel     ,res, &
             tauaer  ,ssaaer  ,asmaer  ,ecaer   , &
             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc, &
! -----      Zhenxin added for ssib coupiling 2011-06-20 --------!
             sibvisdir, sibvisdif, sibnirdir, sibnirdif,         &
! --------------------   End of addition by Zhenxin 2011-06-20 ------!
             swdkdir, swdkdif                      &  ! jararias, 2012/08/10
                                                  )

      endif


! Output net absorbed shortwave surface flux and shortwave cloud forcing
! at the top of atmosphere (W/m2)

! latitude loop
   j_loop2: do j = jts,jte
! longitude loop
      i_loop2: do i = its,ite

! Use calculated output only if in daylight, otherwise output is zero
      dorrsw = .true.
      if (coszr(i,j).le.0.0) dorrsw = .false.
! Complete shortwave calculation if sun above horizon
      if (dorrsw) then

         if (present(xcoszen)) then
            coszr(i,j)=xcoszen(i,j)
            coszrs=xcoszen(i,j)
         else
            call wrf_error_fatal('xcoszen must be passed into RRTMG_SWRAD_FAST')
         endif


         icol = i-its+1 + (j-jts)*(ite-its+1)

         gsw(i,j) = swdflx(icol,1) - swuflx(icol,1)
         swcf(i,j) = (swdflx(icol,kte+2) - swuflx(icol,kte+2)) - (swdflxc(icol,kte+2) - swuflxc(icol,kte+2))

! mji - write
!         swut(i,j) = swuflx(icol,kte+2)
!         swdb(i,j) = swdflx(icol,1)
!
         if (present(swupt)) then 
! Output up and down toa fluxes for total and clear sky
            swupt(i,j)     = swuflx(icol,kte+2)
            swuptc(i,j)    = swuflxc(icol,kte+2)
            swdnt(i,j)     = swdflx(icol,kte+2)
            swdntc(i,j)    = swdflxc(icol,kte+2)
! Output up and down surface fluxes for total and clear sky
            swupb(i,j)     = swuflx(icol,1)
            swupbc(i,j)    = swuflxc(icol,1)
            swdnb(i,j)     = swdflx(icol,1)
! Added by Zhenxin for 4 compenants of swdown radiation
            swvisdir(i,j)  = sibvisdir(icol,1)
            swvisdif(i,j)  = sibvisdif(icol,1)
            swnirdir(i,j)  = sibnirdir(icol,1)
            swnirdif(i,j)  = sibnirdif(icol,1)
!  Ended, Zhenxin (2011/06/20)
            swdnbc(i,j)    = swdflxc(icol,1)
         endif
            swddir(i,j)    = swdkdir(icol,1)       ! jararias 2013/08/10
            swddni(i,j)    = swddir(i,j) / coszrs  ! jararias 2013/08/10
            swddif(i,j)    = swdkdif(icol,1)          ! jararias 2013/08/10

! Output up and down layer fluxes for total and clear sky.
! Vertical ordering is from bottom to top in units of W m-2. 
         if ( present (swupflx) ) then
         do k=kts,kte+2
            swupflx(i,k,j)  = swuflx(icol,k)
            swupflxc(i,k,j) = swuflxc(icol,k)
            swdnflx(i,k,j)  = swdflx(icol,k)
            swdnflxc(i,k,j) = swdflxc(icol,k)
         enddo
         endif

! Output heating rate tendency; convert heating rate from K/d to K/s
! Heating rate arrays are ordered vertically from bottom to top here. 
         do k=kts,kte 
            tten1d(k) = swhr(icol,k)/86400.
            rthratensw(i,k,j) = tten1d(k)/pi3d(i,k,j)
         enddo

      else
         if (present(swupt)) then 
! Output up and down toa fluxes for total and clear sky
            swupt(i,j)     = 0.
            swuptc(i,j)    = 0.
            swdnt(i,j)     = 0.
            swdntc(i,j)    = 0.
! Output up and down surface fluxes for total and clear sky
            swupb(i,j)     = 0.
            swupbc(i,j)    = 0.
            swdnb(i,j)     = 0.
            swdnbc(i,j)    = 0.
            swvisdir(i,j)  = 0.  ! Add by Zhenxin (2011/06/20)
            swvisdif(i,j)  = 0.
            swnirdir(i,j)  = 0.
            swnirdif(i,j)  = 0.  ! Add by Zhenxin (2011/06/20)
         endif
            swddir(i,j)    = 0.  ! jararias 2013/08/10
            swddni(i,j)    = 0.  ! jararias 2013/08/10
            swddif(i,j)    = 0.  ! jararias 2013/08/10

      endif

      end do i_loop2
   end do j_loop2                                           

! mji - write
!      do j=jts,jte
!      write(62,995) (swut(i,j),i=its,ite)
!      enddo
!      do j=jts,jte
!      write(62,995) (swdb(i,j),i=its,ite)
!      enddo
! 995  format(1p6e12.5)

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

   END SUBROUTINE RRTMG_SWRAD_FAST

 
!====================================================================
   SUBROUTINE rrtmg_swinit_fast(                                         &
                       allowed_to_read ,                            &
                       ids, ide, jds, jde, kds, kde,                &
                       ims, ime, jms, jme, kms, kme,                &
                       its, ite, jts, jte, kts, kte                 )
!--------------------------------------------------------------------
   IMPLICIT NONE
!--------------------------------------------------------------------

   LOGICAL , INTENT(IN)           :: allowed_to_read
   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,  &
                                     ims, ime, jms, jme, kms, kme,  &
                                     its, ite, jts, jte, kts, kte

! Read in absorption coefficients and other data
   IF ( allowed_to_read ) THEN
     CALL rrtmg_swlookuptable
   ENDIF

! Perform g-point reduction and other initializations
! Specific heat of dry air (cp) used in flux to heating rate conversion factor.
   call rrtmg_sw_ini(cp)

   END SUBROUTINE rrtmg_swinit_fast


! **************************************************************************     
      SUBROUTINE rrtmg_swlookuptable
! **************************************************************************     

      IMPLICIT NONE

! Local                                    
      INTEGER :: i
      LOGICAL                 :: opened
      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor

      CHARACTER*80 errmess
      INTEGER rrtmg_unit

      IF ( wrf_dm_on_monitor() ) THEN
        DO i = 10,99
          INQUIRE ( i , OPENED = opened )
          IF ( .NOT. opened ) THEN
            rrtmg_unit = i
            GOTO 2010
          ENDIF
        ENDDO
        rrtmg_unit = -1
 2010   CONTINUE
      ENDIF
      CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE )
      IF ( rrtmg_unit < 0 ) THEN
        CALL wrf_error_fatal ( 'module_ra_rrtmg_swf: rrtm_swlookuptable: Can not '// &
                               'find unused fortran unit to read in lookup table.' )
      ENDIF

      IF ( wrf_dm_on_monitor() ) THEN
        OPEN(rrtmg_unit,FILE='RRTMG_SW_DATA',                  &
             FORM='UNFORMATTED',STATUS='OLD',ERR=9009)
      ENDIF

      call sw_kgb16(rrtmg_unit)
      call sw_kgb17(rrtmg_unit)
      call sw_kgb18(rrtmg_unit)
      call sw_kgb19(rrtmg_unit)
      call sw_kgb20(rrtmg_unit)
      call sw_kgb21(rrtmg_unit)
      call sw_kgb22(rrtmg_unit)
      call sw_kgb23(rrtmg_unit)
      call sw_kgb24(rrtmg_unit)
      call sw_kgb25(rrtmg_unit)
      call sw_kgb26(rrtmg_unit)
      call sw_kgb27(rrtmg_unit)
      call sw_kgb28(rrtmg_unit)
      call sw_kgb29(rrtmg_unit)

      IF ( wrf_dm_on_monitor() ) CLOSE (rrtmg_unit)

      RETURN
9009  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error opening '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      END SUBROUTINE rrtmg_swlookuptable

! **************************************************************************
!  RRTMG Shortwave Radiative Transfer Model
!  Atmospheric and Environmental Research, Inc., Cambridge, MA
!
!  Original by J.Delamere, Atmospheric & Environmental Research.
!  Reformatted for F90: JJMorcrette, ECMWF
!  Revision for GCMs:  Michael J. Iacono, AER, July 2002
!  Further F90 reformatting:  Michael J. Iacono, AER, June 2006
!
!  This file contains 14 READ statements that include the 
!  absorption coefficients and other data for each of the 14 shortwave
!  spectral bands used in RRTMG_SW.  Here, the data are defined for 16
!  g-points, or sub-intervals, per band.  These data are combined and
!  weighted using a mapping procedure in module RRTMG_SW_INIT to reduce
!  the total number of g-points from 224 to 112 for use in the GCM.
! **************************************************************************

! **************************************************************************
      subroutine sw_kgb16(rrtmg_unit)
! **************************************************************************

      use rrsw_kg16_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            rayl, strrat1, layreffr
!      use rrsw_kg16_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat1, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 2925 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat1, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat1)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb16

! **************************************************************************
      subroutine sw_kgb17(rrtmg_unit)
! **************************************************************************

      use rrsw_kg17_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            rayl, strrat, layreffr
!      use rrsw_kg17_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 3625 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb17

! **************************************************************************
      subroutine sw_kgb18(rrtmg_unit)
! **************************************************************************

      use rrsw_kg18_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            rayl, strrat, layreffr
!      use rrsw_kg18_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 4325 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb18 

! **************************************************************************
      subroutine sw_kgb19(rrtmg_unit)
! **************************************************************************

      use rrsw_kg19_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            rayl, strrat, layreffr
!      use rrsw_kg19_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 4900 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb19

! **************************************************************************
      subroutine sw_kgb20(rrtmg_unit)
! **************************************************************************

      use rrsw_kg20_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absch4o, rayl, layreffr
!      use rrsw_kg20_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
!                            absch4o, rayl
!      use rrtmg_sw_taumol, only : layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 5670 cm-1.

!     Array absch4o contains the absorption coefficients for methane.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, layreffr, absch4o, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(absch4o)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb20

! **************************************************************************
      subroutine sw_kgb21(rrtmg_unit)
! **************************************************************************

      use rrsw_kg21_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            rayl, strrat, layreffr
!      use rrsw_kg21_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 6925 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb21

! **************************************************************************
      subroutine sw_kgb22(rrtmg_unit)
! **************************************************************************

      use rrsw_kg22_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            rayl, strrat, layreffr
!      use rrsw_kg22_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at v = 8000 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb22

! **************************************************************************
      subroutine sw_kgb23(rrtmg_unit)
! **************************************************************************

      use rrsw_kg23_f, only : kao, selfrefo, forrefo, sfluxrefo, &
                            raylo, givfac, layreffr
!      use rrsw_kg23_f, only : kao, selfrefo, forrefo, sfluxrefo, raylo
!      use rrtmg_sw_taumol, only : givfac, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array raylo contains the Rayleigh extinction coefficient at all v for this band

!     Array givfac is the average Giver et al. correction factor for this band. 

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         raylo, givfac, layreffr, kao, selfrefo, forrefo, sfluxrefo
      DM_BCAST_MACRO(raylo)
      DM_BCAST_REAL(givfac)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb23

! **************************************************************************
      subroutine sw_kgb24(rrtmg_unit)
! **************************************************************************

      use rrsw_kg24_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            raylao, raylbo, abso3ao, abso3bo, strrat, layreffr
!      use rrsw_kg24_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
!                            raylao, raylbo, abso3ao, abso3bo
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Arrays raylao and raylbo contain the Rayleigh extinction coefficient at 
!     all v for this band for the upper and lower atmosphere.

!     Arrays abso3ao and abso3bo contain the ozone absorption coefficient at 
!     all v for this band for the upper and lower atmosphere.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         raylao, raylbo, strrat, layreffr, abso3ao, abso3bo, kao, kbo, selfrefo, &
         forrefo, sfluxrefo
      DM_BCAST_MACRO(raylao)
      DM_BCAST_MACRO(raylbo)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(abso3ao)
      DM_BCAST_MACRO(abso3bo)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb24

! **************************************************************************
      subroutine sw_kgb25(rrtmg_unit)
! **************************************************************************

      use rrsw_kg25_f, only : kao, sfluxrefo, &
                            raylo, abso3ao, abso3bo, layreffr
!      use rrsw_kg25_f, only : kao, sfluxrefo, raylo, abso3ao, abso3bo
!      use rrtmg_sw_taumol, only : layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array raylo contains the Rayleigh extinction coefficient at all v = 2925 cm-1.

!     Arrays abso3ao and abso3bo contain the ozone absorption coefficient at 
!     all v for this band for the upper and lower atmosphere.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         raylo, layreffr, abso3ao, abso3bo, kao, sfluxrefo
      DM_BCAST_MACRO(raylo)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(abso3ao)
      DM_BCAST_MACRO(abso3bo)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb25

! **************************************************************************
      subroutine sw_kgb26(rrtmg_unit)
! **************************************************************************

      use rrsw_kg26_f, only : sfluxrefo, raylo

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array raylo contains the Rayleigh extinction coefficient at all v for this band.

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         raylo, sfluxrefo
      DM_BCAST_MACRO(raylo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb26

! **************************************************************************
      subroutine sw_kgb27(rrtmg_unit)
! **************************************************************************

      use rrsw_kg27_f, only : kao, kbo, sfluxrefo, raylo, &
                            scalekur, layreffr
!      use rrsw_kg27_f, only : kao, kbo, sfluxrefo, raylo
!      use rrtmg_sw_taumol, only : scalekur, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 
!     The values in array sfluxrefo were obtained using the "low resolution"
!     version of the Kurucz solar source function.  For unknown reasons,
!     the total irradiance in this band differs from the corresponding
!     total in the "high-resolution" version of the Kurucz function.
!     Therefore, these values are scaled by the factor SCALEKUR.

!     Array raylo contains the Rayleigh extinction coefficient at all v = 2925 cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         raylo, scalekur, layreffr, kao, kbo, sfluxrefo
      DM_BCAST_MACRO(raylo)
      DM_BCAST_REAL(scalekur)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb27

! **************************************************************************
      subroutine sw_kgb28(rrtmg_unit)
! **************************************************************************

      use rrsw_kg28_f, only : kao, kbo, sfluxrefo, &
                            rayl, strrat, layreffr
!      use rrsw_kg28_f, only : kao, kbo, sfluxrefo, rayl
!      use rrtmg_sw_taumol, only : strrat, layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array raylo contains the Rayleigh extinction coefficient at all v = ???? cm-1.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, strrat, layreffr, kao, kbo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_REAL(strrat)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb28

! **************************************************************************
      subroutine sw_kgb29(rrtmg_unit)
! **************************************************************************

      use rrsw_kg29_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
                            absh2oo, absco2o, rayl, layreffr
!      use rrsw_kg29_f, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
!                            absh2oo, absco2o, rayl
!      use rrtmg_sw_taumol, only : layreffr

      implicit none
      save

! Input
      integer, intent(in) :: rrtmg_unit

! Local                                    
      character*80 errmess
      logical, external  :: wrf_dm_on_monitor

!     Array sfluxrefo contains the Kurucz solar source function for this band. 

!     Array rayl contains the Rayleigh extinction coefficient at all v = 2200 cm-1.

!     Array absh2oo contains the water vapor absorption coefficient for this band.

!     Array absco2o contains the carbon dioxide absorption coefficient for this band.

!     The array KAO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels> ~100mb, temperatures, and binary
!     species parameters (see taumol.f for definition).  The first 
!     index in the array, JS, runs from 1 to 9, and corresponds to 
!     different values of the binary species parameter.  For instance, 
!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, 
!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
!     in the array, JT, which runs from 1 to 5, corresponds to different
!     temperatures.  More specifically, JT = 3 means that the data are for
!     the reference temperature TREF for this  pressure level, JT = 2 refers
!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
!     to the JPth reference pressure level (see taumol.f for these levels
!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
!     which g-interval the absorption coefficients are for.

!     The array KBO contains absorption coefs at the 16 chosen g-values 
!     for a range of pressure levels < ~100mb and temperatures. The first 
!     index in the array, JT, which runs from 1 to 5, corresponds to 
!     different temperatures.  More specifically, JT = 3 means that the 
!     data are for the reference temperature TREF for this pressure 
!     level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
!     TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.  
!     The second index, JP, runs from 13 to 59 and refers to the JPth
!     reference pressure level (see taumol.f for the value of these
!     pressure levels in mb).  The third index, IG, goes from 1 to 16,
!     and tells us which g-interval the absorption coefficients are for.

!     The array FORREFO contains the coefficient of the water vapor
!     foreign-continuum (including the energy term).  The first 
!     index refers to reference temperature (296,260,224,260) and 
!     pressure (970,475,219,3 mbar) levels.  The second index 
!     runs over the g-channel (1 to 16).

!     The array SELFREFO contains the coefficient of the water vapor
!     self-continuum (including the energy term).  The first index
!     refers to temperature in 7.2 degree increments.  For instance,
!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
!     etc.  The second index runs over the g-channel (1 to 16).

#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 )
#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 )

      IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) &
         rayl, layreffr, absh2oo, absco2o, kao, kbo, selfrefo, forrefo, sfluxrefo
      DM_BCAST_REAL(rayl)
      DM_BCAST_INTEGER(layreffr)
      DM_BCAST_MACRO(absh2oo)
      DM_BCAST_MACRO(absco2o)
      DM_BCAST_MACRO(kao)
      DM_BCAST_MACRO(kbo)
      DM_BCAST_MACRO(selfrefo)
      DM_BCAST_MACRO(forrefo)
      DM_BCAST_MACRO(sfluxrefo)

      RETURN
9010  CONTINUE
      WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_swf: error reading '// &
                                  'RRTMG_SW_DATA on unit ',rrtmg_unit
      CALL wrf_error_fatal(errmess)

      end subroutine sw_kgb29

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

      END MODULE module_ra_rrtmg_swf
