Index: /palm/trunk/LIB/rrtmg/Makefile
===================================================================
--- /palm/trunk/LIB/rrtmg/Makefile	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/Makefile	(revision 1585)
@@ -0,0 +1,139 @@
+#--------------------------------------------------------------------------------#
+# This file is part of PALM.
+#
+# PALM is free software: you can redistribute it and/or modify it under the terms
+# of the GNU General Public License as published by the Free Software Foundation,
+# either version 3 of the License, or (at your option) any later version.
+#
+# PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# PALM. If not, see <http://www.gnu.org/licenses/>.
+#
+# Copyright 1997-2015  Leibniz Universitaet Hannover
+#--------------------------------------------------------------------------------#
+#
+# WARNING: don't write filenames with extension .f90 in this header!!!!
+#
+# Current revisions:
+# ------------------
+# Initial revision
+# 
+# Former revisions:
+# -----------------
+# $Id$
+#
+# Description:
+# ------------
+# Makefile for the RRTMG library used in PALM
+#------------------------------------------------------------------------------!
+
+PROG =  librrtmg
+
+SOURCES = rrsw_aer.f90 rrsw_kg18.f90 rrsw_kg23.f90 rrsw_kg28.f90 rrsw_vsn.f90  \
+          rrtmg_sw_reftra.f90 rrtmg_sw_vrtqdr.f90             \
+          rrsw_cld.f90 rrsw_kg19.f90 rrsw_kg24.f90    \
+          rrsw_kg29.f90 rrsw_wvn.f90 rrtmg_sw_setcoef.f90                      \
+          rrsw_con.f90 rrsw_kg20.f90 rrsw_kg25.f90     \
+          rrsw_ncpar.f90 rrtmg_sw_rad.nomcica.f90                 \
+          parkind.f90 rrsw_kg16.f90 rrsw_kg21.f90          \
+          rrsw_kg26.f90 rrsw_ref.f90 rrtmg_sw_cldprop.f90                      \
+          rrtmg_sw_spcvrt.f90 parrrsw.f90             \
+          rrsw_kg17.f90 rrsw_kg22.f90 rrsw_kg27.f90 rrsw_tbl.f90              \
+          rrtmg_sw_init.f90 rrtmg_sw_read_nc.f90 rrtmg_sw_taumol.f90 \
+        rrlw_cld.f90  rrlw_kg01.f90  rrlw_kg03.f90  rrlw_kg05.f90  rrlw_kg07.f90  \
+        rrlw_kg09.f90  rrlw_kg11.f90  rrlw_kg13.f90  rrlw_kg15.f90  rrlw_ncpar.f90   \
+	rrlw_tbl.f90  rrlw_wvn.f90 rrlw_con.f90  rrlw_kg02.f90  rrlw_kg04.f90  rrlw_kg06.f90   \
+        rrlw_kg08.f90  rrlw_kg10.f90  rrlw_kg12.f90  rrlw_kg14.f90  rrlw_kg16.f90  rrlw_ref.f90   \
+        rrlw_vsn.f90 rrtmg_lw_cldprmc.f90  rrtmg_lw_init.f90 \
+        rrtmg_lw_rad.nomcica.f90  rrtmg_lw_rtrn.f90    rrtmg_lw_rtrnmr.f90  \
+        rrtmg_lw_taumol.f90 rrtmg_lw_cldprop.f90   parrrtm.f90 \
+        rrtmg_lw_read_nc.f90 rrtmg_lw_rtrnmc.f90  rrtmg_lw_setcoef.f90
+
+
+OBJS=$(SOURCES:.f90=.o)
+
+CC = cc
+CFLAGS = -O
+
+F90 = 
+COPT = 
+F90FLAGS = 
+
+#to_be_replaced_by_include
+
+.SUFFIXES:
+.SUFFIXES: .o .f90
+
+
+all: $(PROG)
+
+# create static library
+$(PROG): $(OBJS)
+	$(F90) $(F90FLAGS) $(COPT) -o $(PROG).so -shared $(OBJS)
+
+clean:
+	rm -f $(PROG) $(OBJS) *.mod *.i *.lst *.so *.o  *.a
+
+.f90.o:
+	$(F90) $(F90FLAGS) $(COPT) -fpic -c $<
+
+
+
+parrrtm.o: parkind.o
+rrtmg_lw_init.o: parkind.o rrlw_wvn.o rrtmg_lw_setcoef.o rrtmg_lw_rtrnmr.o rrtmg_lw_taumol.o
+rrtmg_lw_rad.nomcica.o: parkind.o rrtmg_lw_cldprop.o rrtmg_lw_rtrn.o
+rrtmg_lw_read_nc.o: parkind.o rrlw_kg01.o rrlw_kg02.o rrlw_kg03.o rrlw_kg04.o rrlw_kg05.o rrlw_kg06.o rrlw_kg07.o rrlw_kg08.o rrlw_kg09.o rrlw_kg10.o rrlw_kg11.o rrlw_kg12.o rrlw_kg13.o rrlw_kg14.o rrlw_kg15.o rrlw_kg16.o
+rrtmg_lw_rtrnmr.o: parkind.o
+rrtmg_lw_taumol.o: parkind.o
+rrlw_kg01.o: parkind.o parrrtm.o
+rrlw_kg02.o: parkind.o parrrtm.o
+rrlw_kg03.o: parkind.o parrrtm.o
+rrlw_kg04.o: parkind.o parrrtm.o
+rrlw_kg05.o: parkind.o parrrtm.o
+rrlw_kg06.o: parkind.o parrrtm.o
+rrlw_kg07.o: parkind.o parrrtm.o
+rrlw_kg08.o: parkind.o parrrtm.o
+rrlw_kg09.o: parkind.o parrrtm.o
+rrlw_kg10.o: parkind.o parrrtm.o
+rrlw_kg11.o: parkind.o parrrtm.o
+rrlw_kg12.o: parkind.o parrrtm.o
+rrlw_kg13.o: parkind.o parrrtm.o
+rrlw_kg14.o: parkind.o parrrtm.o
+rrlw_kg15.o: parkind.o parrrtm.o
+rrlw_kg16.o: parkind.o parrrtm.o
+
+parrrsw.o: parkind.o
+rrtmg_sw_cldprop.o: parkind.o rrsw_cld.o rrsw_wvn.o rrsw_vsn.o
+rrtmg_sw_init.o: parkind.o rrsw_wvn.o rrtmg_sw_setcoef.o
+rrtmg_sw_rad.nomcica.o: parkind.o rrtmg_sw_spcvrt.o rrtmg_sw_cldprop.o
+rrtmg_sw_read_nc.o: parkind.o rrsw_kg16.o rrsw_kg17.o rrsw_kg18.o rrsw_kg19.o rrsw_kg20.o rrsw_kg21.o rrsw_kg22.o rrsw_kg23.o rrsw_kg24.o rrsw_kg25.o rrsw_kg26.o rrsw_kg27.o rrsw_kg28.o rrsw_kg29.o rrsw_ncpar.o
+rrtmg_sw_reftra.o: parkind.o rrsw_tbl.o rrsw_vsn.o
+rrtmg_sw_spcvrt.o: parkind.o parrrsw.o rrsw_tbl.o rrsw_vsn.o rrsw_wvn.o rrtmg_sw_reftra.o rrtmg_sw_taumol.o rrtmg_sw_vrtqdr.o
+rrtmg_sw_setcoef.o: parkind.o rrsw_ref.o
+rrtmg_sw_taumol.o: parkind.o rrsw_con.o rrsw_vsn.o rrsw_wvn.o rrsw_kg16.o rrsw_kg17.o rrsw_kg18.o rrsw_kg19.o rrsw_kg20.o rrsw_kg21.o rrsw_kg22.o rrsw_kg23.o rrsw_kg24.o rrsw_kg25.o rrsw_kg26.o rrsw_kg27.o rrsw_kg28.o rrsw_kg29.o
+rrtmg_sw_vrtqdr.o: parkind.o
+rrsw_aer.o: parkind.o parrrsw.o 
+rrsw_cld.o: parkind.o
+rrsw_con.o: parkind.o
+rrsw_kg16.o: parkind.o parrrsw.o
+rrsw_kg17.o: parkind.o parrrsw.o
+rrsw_kg18.o: parkind.o parrrsw.o
+rrsw_kg19.o: parkind.o parrrsw.o
+rrsw_kg20.o: parkind.o parrrsw.o
+rrsw_kg21.o: parkind.o parrrsw.o
+rrsw_kg22.o: parkind.o parrrsw.o
+rrsw_kg23.o: parkind.o parrrsw.o
+rrsw_kg24.o: parkind.o parrrsw.o
+rrsw_kg25.o: parkind.o parrrsw.o
+rrsw_kg26.o: parkind.o parrrsw.o
+rrsw_kg27.o: parkind.o parrrsw.o
+rrsw_kg28.o: parkind.o parrrsw.o
+rrsw_kg29.o: parkind.o parrrsw.o
+rrsw_ncpar.o: parkind.o
+rrsw_ref.o: parkind.o
+rrsw_tbl.o: parkind.o
+rrsw_vsn.o: parkind.o parrrsw.o
+rrsw_wvn.o: parkind.o parrrsw.o 
Index: /palm/trunk/LIB/rrtmg/Makefile_static
===================================================================
--- /palm/trunk/LIB/rrtmg/Makefile_static	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/Makefile_static	(revision 1585)
@@ -0,0 +1,140 @@
+#--------------------------------------------------------------------------------#
+# This file is part of PALM.
+#
+# PALM is free software: you can redistribute it and/or modify it under the terms
+# of the GNU General Public License as published by the Free Software Foundation,
+# either version 3 of the License, or (at your option) any later version.
+#
+# PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# PALM. If not, see <http://www.gnu.org/licenses/>.
+#
+# Copyright 1997-2015  Leibniz Universitaet Hannover
+#--------------------------------------------------------------------------------#
+#
+# WARNING: don't write filenames with extension .f90 in this header!!!!
+#
+# Current revisions:
+# ------------------
+# Initial revision
+# 
+# Former revisions:
+# -----------------
+# $Id$
+#
+# Description:
+# ------------
+# Makefile for the RRTMG library used in PALM
+#------------------------------------------------------------------------------!
+
+PROG =  librrtmg
+
+SOURCES = rrsw_aer.f90 rrsw_kg18.f90 rrsw_kg23.f90 rrsw_kg28.f90 rrsw_vsn.f90  \
+          rrtmg_sw_reftra.f90 rrtmg_sw_vrtqdr.f90             \
+          rrsw_cld.f90 rrsw_kg19.f90 rrsw_kg24.f90    \
+          rrsw_kg29.f90 rrsw_wvn.f90 rrtmg_sw_setcoef.f90                      \
+          rrsw_con.f90 rrsw_kg20.f90 rrsw_kg25.f90     \
+          rrsw_ncpar.f90 rrtmg_sw_rad.nomcica.f90                 \
+          parkind.f90 rrsw_kg16.f90 rrsw_kg21.f90          \
+          rrsw_kg26.f90 rrsw_ref.f90 rrtmg_sw_cldprop.f90                      \
+          rrtmg_sw_spcvrt.f90 parrrsw.f90           \
+          rrsw_kg17.f90 rrsw_kg22.f90 rrsw_kg27.f90 rrsw_tbl.f90              \
+          rrtmg_sw_init.f90 rrtmg_sw_read_nc.f90 rrtmg_sw_taumol.f90 \
+        rrlw_cld.f90  rrlw_kg01.f90  rrlw_kg03.f90  rrlw_kg05.f90  rrlw_kg07.f90  \
+        rrlw_kg09.f90  rrlw_kg11.f90  rrlw_kg13.f90  rrlw_kg15.f90  rrlw_ncpar.f90   \
+	rrlw_tbl.f90  rrlw_wvn.f90 rrlw_con.f90  rrlw_kg02.f90  rrlw_kg04.f90  rrlw_kg06.f90   \
+        rrlw_kg08.f90  rrlw_kg10.f90  rrlw_kg12.f90  rrlw_kg14.f90  rrlw_kg16.f90  rrlw_ref.f90   \
+        rrlw_vsn.f90 rrtmg_lw_cldprmc.f90  rrtmg_lw_init.f90 \
+        rrtmg_lw_rad.nomcica.f90  rrtmg_lw_rtrn.f90    rrtmg_lw_rtrnmr.f90  \
+        rrtmg_lw_taumol.f90 rrtmg_lw_cldprop.f90 parrrtm.f90 \
+        rrtmg_lw_read_nc.f90 rrtmg_lw_rtrnmc.f90  rrtmg_lw_setcoef.f90
+
+
+OBJS=$(SOURCES:.f90=.o)
+
+CC = cc
+CFLAGS = -O
+
+F90 = 
+COPT = 
+F90FLAGS = 
+
+#to_be_replaced_by_include
+
+.SUFFIXES:
+.SUFFIXES: .o .f90
+
+
+all: $(PROG)
+
+# create static library
+$(PROG): $(OBJS)
+	ar rcs $(PROG).a $(OBJS)
+
+clean:
+	rm -f $(PROG) $(OBJS) *.mod *.i *.lst *.so *.o *.a
+
+.f90.o:
+# compiling for static library
+	$(F90) $(F90FLAGS) $(COPT) -c $<
+
+
+
+parrrtm.o: parkind.o
+rrtmg_lw_init.o: parkind.o rrlw_wvn.o rrtmg_lw_setcoef.o rrtmg_lw_rtrnmr.o rrtmg_lw_taumol.o
+rrtmg_lw_rad.nomcica.o: parkind.o rrtmg_lw_cldprop.o rrtmg_lw_rtrn.o
+rrtmg_lw_read_nc.o: parkind.o rrlw_kg01.o rrlw_kg02.o rrlw_kg03.o rrlw_kg04.o rrlw_kg05.o rrlw_kg06.o rrlw_kg07.o rrlw_kg08.o rrlw_kg09.o rrlw_kg10.o rrlw_kg11.o rrlw_kg12.o rrlw_kg13.o rrlw_kg14.o rrlw_kg15.o rrlw_kg16.o
+rrtmg_lw_rtrnmr.o: parkind.o
+rrtmg_lw_taumol.o: parkind.o
+rrlw_kg01.o: parkind.o parrrtm.o
+rrlw_kg02.o: parkind.o parrrtm.o
+rrlw_kg03.o: parkind.o parrrtm.o
+rrlw_kg04.o: parkind.o parrrtm.o
+rrlw_kg05.o: parkind.o parrrtm.o
+rrlw_kg06.o: parkind.o parrrtm.o
+rrlw_kg07.o: parkind.o parrrtm.o
+rrlw_kg08.o: parkind.o parrrtm.o
+rrlw_kg09.o: parkind.o parrrtm.o
+rrlw_kg10.o: parkind.o parrrtm.o
+rrlw_kg11.o: parkind.o parrrtm.o
+rrlw_kg12.o: parkind.o parrrtm.o
+rrlw_kg13.o: parkind.o parrrtm.o
+rrlw_kg14.o: parkind.o parrrtm.o
+rrlw_kg15.o: parkind.o parrrtm.o
+rrlw_kg16.o: parkind.o parrrtm.o
+
+parrrsw.o: parkind.o
+rrtmg_sw_cldprop.o: parkind.o rrsw_cld.o rrsw_wvn.o rrsw_vsn.o
+rrtmg_sw_init.o: parkind.o rrsw_wvn.o rrtmg_sw_setcoef.o
+rrtmg_sw_rad.nomcica.o: parkind.o rrtmg_sw_spcvrt.o rrtmg_sw_cldprop.o
+rrtmg_sw_read_nc.o: parkind.o rrsw_kg16.o rrsw_kg17.o rrsw_kg18.o rrsw_kg19.o rrsw_kg20.o rrsw_kg21.o rrsw_kg22.o rrsw_kg23.o rrsw_kg24.o rrsw_kg25.o rrsw_kg26.o rrsw_kg27.o rrsw_kg28.o rrsw_kg29.o rrsw_ncpar.o
+rrtmg_sw_reftra.o: parkind.o rrsw_tbl.o rrsw_vsn.o
+rrtmg_sw_spcvrt.o: parkind.o parrrsw.o rrsw_tbl.o rrsw_vsn.o rrsw_wvn.o rrtmg_sw_reftra.o rrtmg_sw_taumol.o rrtmg_sw_vrtqdr.o
+rrtmg_sw_setcoef.o: parkind.o rrsw_ref.o
+rrtmg_sw_taumol.o: parkind.o rrsw_con.o rrsw_vsn.o rrsw_wvn.o rrsw_kg16.o rrsw_kg17.o rrsw_kg18.o rrsw_kg19.o rrsw_kg20.o rrsw_kg21.o rrsw_kg22.o rrsw_kg23.o rrsw_kg24.o rrsw_kg25.o rrsw_kg26.o rrsw_kg27.o rrsw_kg28.o rrsw_kg29.o
+rrtmg_sw_vrtqdr.o: parkind.o
+rrsw_aer.o: parkind.o parrrsw.o 
+rrsw_cld.o: parkind.o
+rrsw_con.o: parkind.o
+rrsw_kg16.o: parkind.o parrrsw.o
+rrsw_kg17.o: parkind.o parrrsw.o
+rrsw_kg18.o: parkind.o parrrsw.o
+rrsw_kg19.o: parkind.o parrrsw.o
+rrsw_kg20.o: parkind.o parrrsw.o
+rrsw_kg21.o: parkind.o parrrsw.o
+rrsw_kg22.o: parkind.o parrrsw.o
+rrsw_kg23.o: parkind.o parrrsw.o
+rrsw_kg24.o: parkind.o parrrsw.o
+rrsw_kg25.o: parkind.o parrrsw.o
+rrsw_kg26.o: parkind.o parrrsw.o
+rrsw_kg27.o: parkind.o parrrsw.o
+rrsw_kg28.o: parkind.o parrrsw.o
+rrsw_kg29.o: parkind.o parrrsw.o
+rrsw_ncpar.o: parkind.o
+rrsw_ref.o: parkind.o
+rrsw_tbl.o: parkind.o
+rrsw_vsn.o: parkind.o parrrsw.o
+rrsw_wvn.o: parkind.o parrrsw.o 
Index: /palm/trunk/LIB/rrtmg/install_rrtmg
===================================================================
--- /palm/trunk/LIB/rrtmg/install_rrtmg	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/install_rrtmg	(revision 1585)
@@ -0,0 +1,175 @@
+#!/bin/ksh 
+
+# install_rrtmg - install script for creating a RRTMG library
+
+#--------------------------------------------------------------------------------#
+# This file is part of PALM.
+#
+# PALM is free software: you can redistribute it and/or modify it under the terms
+# of the GNU General Public License as published by the Free Software Foundation,
+# either version 3 of the License, or (at your option) any later version.
+#
+# PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# PALM. If not, see <http://www.gnu.org/licenses/>.
+#
+# Copyright 1997-2015  Leibniz Universitaet Hannover
+#--------------------------------------------------------------------------------#
+#
+# Current revisions:
+# ------------------
+# Initial revision
+# 
+# Former revisions:
+# -----------------
+# $Id$
+#
+#--------------------------------------------------------------------------------#
+# install_rrtmg - install script for creating a RRTMG library
+#--------------------------------------------------------------------------------#
+
+# the following variables must be modified for the local system according to
+# .mrun.config
+#
+# Example 1 (lcmuk):
+# compiler_name="mpif90"
+# fopts="-fltconsistency -O3 -cpp -r8 -nbs -convert little_endian -I /muksoft/packages/netcdf/4_intel/include"
+# fopts_trace="-fpe0 -C -check nooutput_conversion -debug -traceback -g -w -xT -O0 -ftz -fno-alias -no-prec-div -no-prec-sqrt -ip -nbs -convert little_endian -diag-disable 8290,8291 -I /muksoft/packages/netcdf/4_intel/include"
+#
+# Example 2 (lccrayh):
+# compiler_name="ftn"
+# fopts="-em -s real64 -O3 -hnoomp -hfp3 -hdynamic"
+#
+#
+
+ compiler_name="mpif90"
+ fopts="-fltconsistency -O3 -cpp -r8 -nbs -convert little_endian -I /muksoft/packages/netcdf/4_intel/include"
+ fopts_trace="-fpe0 -C -check nooutput_conversion -debug -traceback -g -w -xT -O0 -ftz -fno-alias -no-prec-div -no-prec-sqrt -ip -nbs -convert little_endian -diag-disable 8290,8291 -I /muksoft/packages/netcdf/4_intel/include"
+ install_path="$HOME/palm/rrtmg"
+ compile_static=true
+ compile_shared=true
+ compile_static_debug=false
+ compile_shared_debug=false
+
+ while  getopts  p: option
+ do
+   case  $option  in
+       (p)   install_path=$OPTARG;;
+ 
+       (\?)  printf "\n  +++ unknown option $OPTARG \n"
+             printf "\n  --> type \"$0 ?\" for available options \n"
+             locat=parameter;exit;;
+   esac
+ done
+
+ (( to_shift = $OPTIND - 1 ))
+ shift $to_shift
+
+    # PRINT SHORT DESCRIPTION OF OPTIONS
+ if [[ "$1" = "?" ]]
+ then
+   (printf "\n  *** rrtmg_install can be called as follows:\n"
+    printf "\n      rrtmg_install -p.\n"
+    printf "\n      Description of available options:\n"
+    printf "\n      Option  Description                              Default-Value"
+    printf "\n        -p    installation path                                   ./"
+
+    printf "\n "
+    printf "\n      Possible values of positional parameter <modus>:"
+    printf "\n        \"?\"       -  this outline \n\n") | more
+    exit
+ elif [[ "$1" != "" ]]
+ then
+    printf "\n  +++ positional parameter $1 unknown \n"
+    locat=parameter; exit
+ fi
+
+ prog="librrtmg"
+ version="1.0"
+
+
+# 1 static
+
+ if [[ $compile_static = true ]]
+ then
+    printf "\n      Start compiling static library $prog... (make)\n\n"
+    mkdir -p static/lib
+    mkdir -p static/include
+    make -f Makefile_static F90=$compiler_name  PROG=$prog F90FLAGS="$fopts"
+    cp $prog.a  static/lib
+    cp *.mod    static/include
+    make -f Makefile_static clean
+    mkdir -p $install_path/static/lib
+    mkdir -p $install_path/static/include
+    cp static/lib/$prog.a $install_path/static/lib
+    cp static/include/*.mod $install_path/static/include/
+    rm -rf static
+    printf "\n      finished.\n"
+ fi
+
+# 2 static debug
+ if [[ $compile_static_debug = true ]]
+ then
+    printf "\n      Start compiling static debug library $prog... (make)\n\n"
+    mkdir -p static_trace/lib
+    mkdir -p static_trace/include
+    make -f Makefile_static F90=$compiler_name  PROG=$prog F90FLAGS="$fopts_trace"
+    cp $prog.a  static_trace/lib
+    cp *.mod    static_trace/include
+    make -f Makefile_static clean
+    mkdir -p $install_path/static_trace/lib
+    mkdir -p $install_path/static_trace/include
+    cp static_trace/lib/$prog.a $install_path/static_trace/lib
+    cp static_trace/include/*.mod $install_path/static_trace/include/
+    rm -rf static_trace
+    printf "\n      finished.\n"
+ fi
+
+# 3 shared
+ if [[ $compile_shared = true ]]
+ then
+    printf "\n      Start compiling shared (dynamic) library $prog... (make)\n\n"
+    mkdir -p shared/lib
+    mkdir -p shared/include
+    make -f Makefile F90=$compiler_name  PROG=$prog F90FLAGS="$fopts"
+    cp $prog.so shared/lib/$prog.so.$version
+    cp *.mod    shared/include/
+    make -f Makefile clean
+    mkdir -p $install_path/shared/lib
+    mkdir -p $install_path/shared/include
+    cp shared/lib/$prog.so.$version $install_path/shared/lib
+    cp shared/include/*.mod $install_path/shared/include/
+    rm $install_path/shared/lib/$prog.so.$version $install_path/shared/lib/$prog.so.1
+    ln -s $install_path/shared/lib/$prog.so.$version $install_path/shared/lib/$prog.so.1
+    ln -s $install_path/shared/lib/$prog.so.1 $install_path/shared/lib/$prog.so
+    rm -rf shared
+    printf "\n      finished.\n"
+ fi
+
+# 4 shared debug
+ if [[ $compile_static_debug = true ]]
+ then
+    printf "\n      Start compiling shared debug library $prog... (make)\n\n"
+    mkdir -p shared_trace/lib
+    mkdir -p shared_trace/include
+    make -f Makefile F90=$compiler_name  PROG=$prog F90FLAGS="$fopts_trace"
+    cp $prog.so shared_trace/lib/$prog.so.$version
+    cp *.mod    shared_trace/include/
+    make -f Makefile clean
+    mkdir -p $install_path/shared_trace/lib
+    mkdir -p $install_path/shared_trace/include
+    cp shared_trace/lib/$prog.so.$version $install_path/shared_trace/lib
+    cp shared_trace/include/*.mod $install_path/shared_trace/include/
+    rm $install_path/shared_trace/lib/$prog.so.$version $install_path/shared_trace/lib/$prog.so.1
+    ln -s $install_path/shared_trace/lib/$prog.so.$version $install_path/shared_trace/lib/$prog.so.1
+    ln -s $install_path/shared_trace/lib/$prog.so.1 $install_path/shared_trace/lib/$prog.so
+    rm -rf shared_trace
+    printf "\n      finished.\n"
+ fi
+
+ printf "\n      Libraries $prog are installed in \"$install_path\".\n\n" 
+ printf "\n\n  *** all actions complete."
+ 
Index: /palm/trunk/LIB/rrtmg/parkind.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/parkind.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/parkind.f90	(revision 1585)
@@ -0,0 +1,30 @@
+      module parkind
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg kinds
+! Define integer and real kinds for various types.
+!
+! Initial version: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!------------------------------------------------------------------
+
+!
+!     integer kinds
+!     -------------
+!
+      integer, parameter :: kind_ib = selected_int_kind(13)  ! 8 byte integer
+      integer, parameter :: kind_im = selected_int_kind(6)   ! 4 byte integer
+      integer, parameter :: kind_in = kind(1)                ! native integer
+
+!
+!     real kinds
+!     ----------
+!
+      integer, parameter :: kind_rb = selected_real_kind(12) ! 8 byte real
+      integer, parameter :: kind_rm = selected_real_kind(6)  ! 4 byte real
+      integer, parameter :: kind_rn = kind(1.0)              ! native real
+
+      end module parkind
Index: /palm/trunk/LIB/rrtmg/parrrsw.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/parrrsw.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/parrrsw.f90	(revision 1585)
@@ -0,0 +1,119 @@
+
+      module parrrsw
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      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(kind=im), parameter :: mxlay  = 203    !jplay, klev
+      integer(kind=im), parameter :: mg     = 16     !jpg
+      integer(kind=im), parameter :: nbndsw = 14     !jpsw, ksw
+      integer(kind=im), parameter :: naerec  = 6     !jpaer
+      integer(kind=im), parameter :: mxmol  = 38
+      integer(kind=im), parameter :: nstr   = 2
+      integer(kind=im), parameter :: nmol   = 7
+! Use for 112 g-point model   
+      integer(kind=im), parameter :: ngptsw = 112    !jpgpt
+! Use for 224 g-point model   
+!      integer(kind=im), parameter :: ngptsw = 224   !jpgpt
+
+! may need to rename these - from v2.6
+      integer(kind=im), parameter :: jpband   = 29
+      integer(kind=im), parameter :: jpb1     = 16   !istart
+      integer(kind=im), parameter :: jpb2     = 29   !iend
+
+      integer(kind=im), parameter :: jmcmu    = 32
+      integer(kind=im), parameter :: jmumu    = 32
+      integer(kind=im), parameter :: jmphi    = 3
+      integer(kind=im), parameter :: jmxang   = 4
+      integer(kind=im), parameter :: jmxstr   = 16
+! ^
+
+! Use for 112 g-point model   
+      integer(kind=im), parameter :: ng16 = 6
+      integer(kind=im), parameter :: ng17 = 12
+      integer(kind=im), parameter :: ng18 = 8
+      integer(kind=im), parameter :: ng19 = 8
+      integer(kind=im), parameter :: ng20 = 10
+      integer(kind=im), parameter :: ng21 = 10
+      integer(kind=im), parameter :: ng22 = 2
+      integer(kind=im), parameter :: ng23 = 10
+      integer(kind=im), parameter :: ng24 = 8
+      integer(kind=im), parameter :: ng25 = 6
+      integer(kind=im), parameter :: ng26 = 6
+      integer(kind=im), parameter :: ng27 = 8
+      integer(kind=im), parameter :: ng28 = 6
+      integer(kind=im), parameter :: ng29 = 12
+
+      integer(kind=im), parameter :: ngs16 = 6
+      integer(kind=im), parameter :: ngs17 = 18
+      integer(kind=im), parameter :: ngs18 = 26
+      integer(kind=im), parameter :: ngs19 = 34
+      integer(kind=im), parameter :: ngs20 = 44
+      integer(kind=im), parameter :: ngs21 = 54
+      integer(kind=im), parameter :: ngs22 = 56
+      integer(kind=im), parameter :: ngs23 = 66
+      integer(kind=im), parameter :: ngs24 = 74
+      integer(kind=im), parameter :: ngs25 = 80
+      integer(kind=im), parameter :: ngs26 = 86
+      integer(kind=im), parameter :: ngs27 = 94
+      integer(kind=im), parameter :: ngs28 = 100
+      integer(kind=im), parameter :: ngs29 = 112
+
+! Use for 224 g-point model   
+!      integer(kind=im), parameter :: ng16 = 16
+!      integer(kind=im), parameter :: ng17 = 16
+!      integer(kind=im), parameter :: ng18 = 16
+!      integer(kind=im), parameter :: ng19 = 16
+!      integer(kind=im), parameter :: ng20 = 16
+!      integer(kind=im), parameter :: ng21 = 16
+!      integer(kind=im), parameter :: ng22 = 16
+!      integer(kind=im), parameter :: ng23 = 16
+!      integer(kind=im), parameter :: ng24 = 16
+!      integer(kind=im), parameter :: ng25 = 16
+!      integer(kind=im), parameter :: ng26 = 16
+!      integer(kind=im), parameter :: ng27 = 16
+!      integer(kind=im), parameter :: ng28 = 16
+!      integer(kind=im), parameter :: ng29 = 16
+
+!      integer(kind=im), parameter :: ngs16 = 16
+!      integer(kind=im), parameter :: ngs17 = 32
+!      integer(kind=im), parameter :: ngs18 = 48
+!      integer(kind=im), parameter :: ngs19 = 64
+!      integer(kind=im), parameter :: ngs20 = 80
+!      integer(kind=im), parameter :: ngs21 = 96
+!      integer(kind=im), parameter :: ngs22 = 112
+!      integer(kind=im), parameter :: ngs23 = 128
+!      integer(kind=im), parameter :: ngs24 = 144
+!      integer(kind=im), parameter :: ngs25 = 160
+!      integer(kind=im), parameter :: ngs26 = 176
+!      integer(kind=im), parameter :: ngs27 = 192
+!      integer(kind=im), parameter :: ngs28 = 208
+!      integer(kind=im), parameter :: ngs29 = 224
+
+! Source function solar constant
+      real(kind=rb), parameter :: rrsw_scon = 1.36822e+03     ! W/m2
+ 
+      end module parrrsw
+
+
Index: /palm/trunk/LIB/rrtmg/parrrtm.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/parrrtm.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/parrrtm.f90	(revision 1585)
@@ -0,0 +1,112 @@
+
+      module parrrtm
+
+      use parkind ,only : im => kind_im
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw main parameters
+!
+! Initial version:  JJMorcrette, ECMWF, Jul 1998
+! Revised: MJIacono, AER, Jun 2006
+! Revised: MJIacono, AER, Aug 2007
+! Revised: MJIacono, AER, Aug 2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! mxlay  :  integer: maximum number of layers
+! mg     :  integer: number of original g-intervals per spectral band
+! nbndlw :  integer: number of spectral bands
+! maxxsec:  integer: maximum number of cross-section molecules
+!                    (e.g. cfcs)
+! maxinpx:  integer: 
+! ngptlw :  integer: total number of reduced g-intervals for rrtmg_lw
+! ngNN   :  integer: number of reduced g-intervals per spectral band
+! ngsNN  :  integer: cumulative number of g-intervals per band
+!------------------------------------------------------------------
+
+      integer(kind=im), parameter :: mxlay  = 203
+      integer(kind=im), parameter :: mg     = 16
+      integer(kind=im), parameter :: nbndlw = 16
+      integer(kind=im), parameter :: maxxsec= 4
+      integer(kind=im), parameter :: mxmol  = 38
+      integer(kind=im), parameter :: maxinpx= 38
+      integer(kind=im), parameter :: nmol   = 7
+! Use for 140 g-point model 
+      integer(kind=im), parameter :: ngptlw = 140
+! Use for 256 g-point model 
+!      integer(kind=im), parameter :: ngptlw = 256
+
+! Use for 140 g-point model
+      integer(kind=im), parameter :: ng1  = 10
+      integer(kind=im), parameter :: ng2  = 12
+      integer(kind=im), parameter :: ng3  = 16
+      integer(kind=im), parameter :: ng4  = 14
+      integer(kind=im), parameter :: ng5  = 16
+      integer(kind=im), parameter :: ng6  = 8
+      integer(kind=im), parameter :: ng7  = 12
+      integer(kind=im), parameter :: ng8  = 8
+      integer(kind=im), parameter :: ng9  = 12
+      integer(kind=im), parameter :: ng10 = 6
+      integer(kind=im), parameter :: ng11 = 8
+      integer(kind=im), parameter :: ng12 = 8
+      integer(kind=im), parameter :: ng13 = 4
+      integer(kind=im), parameter :: ng14 = 2
+      integer(kind=im), parameter :: ng15 = 2
+      integer(kind=im), parameter :: ng16 = 2
+
+      integer(kind=im), parameter :: ngs1  = 10
+      integer(kind=im), parameter :: ngs2  = 22
+      integer(kind=im), parameter :: ngs3  = 38
+      integer(kind=im), parameter :: ngs4  = 52
+      integer(kind=im), parameter :: ngs5  = 68
+      integer(kind=im), parameter :: ngs6  = 76
+      integer(kind=im), parameter :: ngs7  = 88
+      integer(kind=im), parameter :: ngs8  = 96
+      integer(kind=im), parameter :: ngs9  = 108
+      integer(kind=im), parameter :: ngs10 = 114
+      integer(kind=im), parameter :: ngs11 = 122
+      integer(kind=im), parameter :: ngs12 = 130
+      integer(kind=im), parameter :: ngs13 = 134
+      integer(kind=im), parameter :: ngs14 = 136
+      integer(kind=im), parameter :: ngs15 = 138
+
+! Use for 256 g-point model
+!      integer(kind=im), parameter :: ng1  = 16
+!      integer(kind=im), parameter :: ng2  = 16
+!      integer(kind=im), parameter :: ng3  = 16
+!      integer(kind=im), parameter :: ng4  = 16
+!      integer(kind=im), parameter :: ng5  = 16
+!      integer(kind=im), parameter :: ng6  = 16
+!      integer(kind=im), parameter :: ng7  = 16
+!      integer(kind=im), parameter :: ng8  = 16
+!      integer(kind=im), parameter :: ng9  = 16
+!      integer(kind=im), parameter :: ng10 = 16
+!      integer(kind=im), parameter :: ng11 = 16
+!      integer(kind=im), parameter :: ng12 = 16
+!      integer(kind=im), parameter :: ng13 = 16
+!      integer(kind=im), parameter :: ng14 = 16
+!      integer(kind=im), parameter :: ng15 = 16
+!      integer(kind=im), parameter :: ng16 = 16
+
+!      integer(kind=im), parameter :: ngs1  = 16
+!      integer(kind=im), parameter :: ngs2  = 32
+!      integer(kind=im), parameter :: ngs3  = 48
+!      integer(kind=im), parameter :: ngs4  = 64
+!      integer(kind=im), parameter :: ngs5  = 80
+!      integer(kind=im), parameter :: ngs6  = 96
+!      integer(kind=im), parameter :: ngs7  = 112
+!      integer(kind=im), parameter :: ngs8  = 128
+!      integer(kind=im), parameter :: ngs9  = 144
+!      integer(kind=im), parameter :: ngs10 = 160
+!      integer(kind=im), parameter :: ngs11 = 176
+!      integer(kind=im), parameter :: ngs12 = 192
+!      integer(kind=im), parameter :: ngs13 = 208
+!      integer(kind=im), parameter :: ngs14 = 224
+!      integer(kind=im), parameter :: ngs15 = 240
+!      integer(kind=im), parameter :: ngs16 = 256
+
+      end module parrrtm
Index: /palm/trunk/LIB/rrtmg/rrlw_cld.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_cld.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_cld.f90	(revision 1585)
@@ -0,0 +1,35 @@
+      module rrlw_cld
+
+      use parkind, only : rb => kind_rb
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw cloud property coefficients
+
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! abscld1:  real   : 
+! absice0:  real   : 
+! absice1:  real   : 
+! absice2:  real   : 
+! absice3:  real   : 
+! absliq0:  real   : 
+! absliq1:  real   : 
+!------------------------------------------------------------------
+
+      real(kind=rb) :: abscld1
+      real(kind=rb) , dimension(2) :: absice0
+      real(kind=rb) , dimension(2,5) :: absice1
+      real(kind=rb) , dimension(43,16) :: absice2
+      real(kind=rb) , dimension(46,16) :: absice3
+      real(kind=rb) :: absliq0
+      real(kind=rb) , dimension(58,16) :: absliq1
+
+      end module rrlw_cld
+
Index: /palm/trunk/LIB/rrtmg/rrlw_con.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_con.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_con.f90	(revision 1585)
@@ -0,0 +1,42 @@
+      module rrlw_con
+
+      use parkind, only : rb => kind_rb
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw constants
+
+! Initial version: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! fluxfac:  real   : radiance to flux conversion factor 
+! heatfac:  real   : flux to heating rate conversion factor
+!oneminus:  real   : 1.-1.e-6
+! pi     :  real   : pi
+! grav   :  real   : acceleration of gravity
+! planck :  real   : planck constant
+! boltz  :  real   : boltzmann constant
+! clight :  real   : speed of light
+! avogad :  real   : avogadro constant 
+! alosmt :  real   : loschmidt constant
+! gascon :  real   : molar gas constant
+! radcn1 :  real   : first radiation constant
+! radcn2 :  real   : second radiation constant
+! sbcnst :  real   : stefan-boltzmann constant
+!  secdy :  real   : seconds per day  
+!------------------------------------------------------------------
+
+      real(kind=rb) :: fluxfac, heatfac
+      real(kind=rb) :: oneminus, pi, grav
+      real(kind=rb) :: planck, boltz, clight
+      real(kind=rb) :: avogad, alosmt, gascon
+      real(kind=rb) :: radcn1, radcn2
+      real(kind=rb) :: sbcnst, secdy
+
+      end module rrlw_con
+
Index: /palm/trunk/LIB/rrtmg/rrlw_kg01.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg01.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg01.f90	(revision 1585)
@@ -0,0 +1,74 @@
+      module rrlw_kg01
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 1
+! band 1:  10-250 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real
+! kao     : real     
+! kbo     : real     
+! kao_mn2 : real     
+! kbo_mn2 : real     
+! selfrefo: real     
+! forrefo : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no1  = 16
+
+      real(kind=rb) :: fracrefao(no1)  , fracrefbo(no1)
+      real(kind=rb) :: kao(5,13,no1)
+      real(kind=rb) :: kbo(5,13:59,no1)
+      real(kind=rb) :: kao_mn2(19,no1) , kbo_mn2(19,no1)
+      real(kind=rb) :: selfrefo(10,no1), forrefo(4,no1)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 1
+! band 1:  10-250 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real
+! ka      : real     
+! kb      : real     
+! absa    : real
+! absb    : real
+! ka_mn2  : real     
+! kb_mn2  : real     
+! selfref : real     
+! forref  : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng1  = 10
+
+      real(kind=rb) :: fracrefa(ng1)  , fracrefb(ng1)
+      real(kind=rb) :: ka(5,13,ng1)   , absa(65,ng1)
+      real(kind=rb) :: kb(5,13:59,ng1), absb(235,ng1)
+      real(kind=rb) :: ka_mn2(19,ng1) , kb_mn2(19,ng1)
+      real(kind=rb) :: selfref(10,ng1), forref(4,ng1)
+
+      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg01
+
+
+
+
Index: /palm/trunk/LIB/rrtmg/rrlw_kg02.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg02.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg02.f90	(revision 1585)
@@ -0,0 +1,70 @@
+      module rrlw_kg02
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 2
+! band 2:  250-500 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real
+! kao     : real     
+! kbo     : real     
+! selfrefo: real     
+! forrefo : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no2  = 16
+
+      real(kind=rb) :: fracrefao(no2)   , fracrefbo(no2)
+      real(kind=rb) :: kao(5,13,no2)
+      real(kind=rb) :: kbo(5,13:59,no2)
+      real(kind=rb) :: selfrefo(10,no2) , forrefo(4,no2)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 2
+! band 2:  250-500 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real
+! ka      : real     
+! kb      : real     
+! absa    : real
+! absb    : real
+! selfref : real     
+! forref  : real
+!
+! refparam: real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng2  = 12
+
+      real(kind=rb) :: fracrefa(ng2)  , fracrefb(ng2)
+      real(kind=rb) :: ka(5,13,ng2)   , absa(65,ng2)
+      real(kind=rb) :: kb(5,13:59,ng2), absb(235,ng2)
+      real(kind=rb) :: selfref(10,ng2), forref(4,ng2)
+
+      real(kind=rb) :: refparam(13)
+
+      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg02
+
+
Index: /palm/trunk/LIB/rrtmg/rrlw_kg03.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg03.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg03.f90	(revision 1585)
@@ -0,0 +1,75 @@
+      module rrlw_kg03
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 3
+! band 3:  500-630 cm-1 (low - h2o,co2; high - h2o,co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real
+! kao     : real     
+! kbo     : real     
+! kao_mn2o: real     
+! kbo_mn2o: real     
+! selfrefo: real     
+! forrefo : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no3  = 16
+
+      real(kind=rb) :: fracrefao(no3,9) ,fracrefbo(no3,5)
+      real(kind=rb) :: kao(9,5,13,no3)
+      real(kind=rb) :: kbo(5,5,13:59,no3)
+      real(kind=rb) :: kao_mn2o(9,19,no3), kbo_mn2o(5,19,no3)
+      real(kind=rb) :: selfrefo(10,no3)
+      real(kind=rb) :: forrefo(4,no3)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 3
+! band 3:  500-630 cm-1 (low - h2o,co2; high - h2o,co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real
+! ka      : real     
+! kb      : real     
+! ka_mn2o : real     
+! kb_mn2o : real     
+! selfref : real     
+! forref  : real
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng3  = 16
+
+      real(kind=rb) :: fracrefa(ng3,9) ,fracrefb(ng3,5)
+      real(kind=rb) :: ka(9,5,13,ng3)  ,absa(585,ng3)
+      real(kind=rb) :: kb(5,5,13:59,ng3),absb(1175,ng3)
+      real(kind=rb) :: ka_mn2o(9,19,ng3), kb_mn2o(5,19,ng3)
+      real(kind=rb) :: selfref(10,ng3)
+      real(kind=rb) :: forref(4,ng3)
+
+      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1))
+
+      end module rrlw_kg03
+
+
Index: /palm/trunk/LIB/rrtmg/rrlw_kg04.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg04.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg04.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrlw_kg04
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 4
+! band 4:  630-700 cm-1 (low - h2o,co2; high - o3,co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real
+! kao     : real     
+! kbo     : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no4  = 16
+
+      real(kind=rb) :: fracrefao(no4,9)  ,fracrefbo(no4,5)
+      real(kind=rb) :: kao(9,5,13,no4)
+      real(kind=rb) :: kbo(5,5,13:59,no4)
+      real(kind=rb) :: selfrefo(10,no4)  ,forrefo(4,no4)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 4
+! band 4:  630-700 cm-1 (low - h2o,co2; high - o3,co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+! absa    : real
+! absb    : real
+!fracrefa : real    
+!fracrefb : real
+! ka      : real     
+! kb      : real     
+! selfref : real     
+! forref  : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng4  = 14
+
+      real(kind=rb) :: fracrefa(ng4,9)  ,fracrefb(ng4,5)
+      real(kind=rb) :: ka(9,5,13,ng4)   ,absa(585,ng4)
+      real(kind=rb) :: kb(5,5,13:59,ng4),absb(1175,ng4)
+      real(kind=rb) :: selfref(10,ng4)  ,forref(4,ng4)
+
+      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1))
+
+      end module rrlw_kg04
Index: /palm/trunk/LIB/rrtmg/rrlw_kg05.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg05.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg05.f90	(revision 1585)
@@ -0,0 +1,76 @@
+      module rrlw_kg05
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 5
+! band 5:  700-820 cm-1 (low - h2o,co2; high - o3,co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real
+! kao     : real     
+! kbo     : real     
+! kao_mo3 : real     
+! selfrefo: real     
+! forrefo : real     
+! ccl4o   : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no5  = 16
+
+      real(kind=rb) :: fracrefao(no5,9) ,fracrefbo(no5,5)
+      real(kind=rb) :: kao(9,5,13,no5)
+      real(kind=rb) :: kbo(5,5,13:59,no5)
+      real(kind=rb) :: kao_mo3(9,19,no5)
+      real(kind=rb) :: selfrefo(10,no5)
+      real(kind=rb) :: forrefo(4,no5)
+      real(kind=rb) :: ccl4o(no5)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 5
+! band 5:  700-820 cm-1 (low - h2o,co2; high - o3,co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real
+! ka      : real     
+! kb      : real     
+! ka_mo3  : real     
+! selfref : real     
+! forref  : real     
+! ccl4    : real
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng5  = 16
+
+      real(kind=rb) :: fracrefa(ng5,9) ,fracrefb(ng5,5)
+      real(kind=rb) :: ka(9,5,13,ng5)   ,absa(585,ng5)
+      real(kind=rb) :: kb(5,5,13:59,ng5),absb(1175,ng5)
+      real(kind=rb) :: ka_mo3(9,19,ng5)
+      real(kind=rb) :: selfref(10,ng5)
+      real(kind=rb) :: forref(4,ng5)
+      real(kind=rb) :: ccl4(ng5)
+      
+      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,1,13,1),absb(1,1))
+
+      end module rrlw_kg05
+
Index: /palm/trunk/LIB/rrtmg/rrlw_kg06.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg06.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg06.f90	(revision 1585)
@@ -0,0 +1,74 @@
+      module rrlw_kg06
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 6
+! band 6:  820-980 cm-1 (low - h2o; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+! kao     : real     
+! kao_mco2: real     
+! selfrefo: real     
+! forrefo : real     
+!cfc11adjo: real
+! cfc12o  : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no6  = 16
+
+      real(kind=rb) , dimension(no6) :: fracrefao
+      real(kind=rb) :: kao(5,13,no6)
+      real(kind=rb) :: kao_mco2(19,no6)
+      real(kind=rb) :: selfrefo(10,no6)
+      real(kind=rb) :: forrefo(4,no6)
+
+      real(kind=rb) , dimension(no6) :: cfc11adjo
+      real(kind=rb) , dimension(no6) :: cfc12o
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 6
+! band 6:  820-980 cm-1 (low - h2o; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+! ka      : real     
+! ka_mco2 : real     
+! selfref : real     
+! forref  : real     
+!cfc11adj : real
+! cfc12   : real
+!
+! absa    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng6  = 8
+
+      real(kind=rb) , dimension(ng6) :: fracrefa
+      real(kind=rb) :: ka(5,13,ng6),absa(65,ng6)
+      real(kind=rb) :: ka_mco2(19,ng6)
+      real(kind=rb) :: selfref(10,ng6)
+      real(kind=rb) :: forref(4,ng6)
+
+      real(kind=rb) , dimension(ng6) :: cfc11adj
+      real(kind=rb) , dimension(ng6) :: cfc12
+
+      equivalence (ka(1,1,1),absa(1,1))
+
+      end module rrlw_kg06
Index: /palm/trunk/LIB/rrtmg/rrlw_kg07.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg07.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg07.f90	(revision 1585)
@@ -0,0 +1,76 @@
+      module rrlw_kg07
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 7
+! band 7:  980-1080 cm-1 (low - h2o,o3; high - o3)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! kao_mco2: real     
+! kbo_mco2: real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no7  = 16
+
+      real(kind=rb) , dimension(no7) :: fracrefbo
+      real(kind=rb) :: fracrefao(no7,9)
+      real(kind=rb) :: kao(9,5,13,no7)
+      real(kind=rb) :: kbo(5,13:59,no7)
+      real(kind=rb) :: kao_mco2(9,19,no7)
+      real(kind=rb) :: kbo_mco2(19,no7)
+      real(kind=rb) :: selfrefo(10,no7)
+      real(kind=rb) :: forrefo(4,no7)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 7
+! band 7:  980-1080 cm-1 (low - h2o,o3; high - o3)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real    
+! ka      : real     
+! kb      : real     
+! ka_mco2 : real     
+! kb_mco2 : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng7  = 12
+
+      real(kind=rb) , dimension(ng7) :: fracrefb
+      real(kind=rb) :: fracrefa(ng7,9)
+      real(kind=rb) :: ka(9,5,13,ng7) ,absa(585,ng7)
+      real(kind=rb) :: kb(5,13:59,ng7),absb(235,ng7)
+      real(kind=rb) :: ka_mco2(9,19,ng7)
+      real(kind=rb) :: kb_mco2(19,ng7)
+      real(kind=rb) :: selfref(10,ng7)
+      real(kind=rb) :: forref(4,ng7)
+
+      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg07
Index: /palm/trunk/LIB/rrtmg/rrlw_kg08.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg08.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg08.f90	(revision 1585)
@@ -0,0 +1,100 @@
+      module rrlw_kg08
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 8
+! band 8:  1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! kao_mco2: real     
+! kbo_mco2: real     
+! kao_mn2o: real     
+! kbo_mn2o: real     
+! kao_mo3 : real     
+! selfrefo: real     
+! forrefo : real     
+! cfc12o  : real     
+!cfc22adjo: real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no8  = 16
+
+      real(kind=rb) , dimension(no8) :: fracrefao
+      real(kind=rb) , dimension(no8) :: fracrefbo
+      real(kind=rb) , dimension(no8) :: cfc12o
+      real(kind=rb) , dimension(no8) :: cfc22adjo
+
+      real(kind=rb) :: kao(5,13,no8)
+      real(kind=rb) :: kao_mco2(19,no8)
+      real(kind=rb) :: kao_mn2o(19,no8)
+      real(kind=rb) :: kao_mo3(19,no8)
+      real(kind=rb) :: kbo(5,13:59,no8)
+      real(kind=rb) :: kbo_mco2(19,no8)
+      real(kind=rb) :: kbo_mn2o(19,no8)
+      real(kind=rb) :: selfrefo(10,no8)
+      real(kind=rb) :: forrefo(4,no8)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 8
+! band 8:  1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real    
+! ka      : real     
+! kb      : real     
+! ka_mco2 : real     
+! kb_mco2 : real     
+! ka_mn2o : real     
+! kb_mn2o : real     
+! ka_mo3  : real     
+! selfref : real     
+! forref  : real     
+! cfc12   : real     
+! cfc22adj: real     
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng8  = 8
+
+      real(kind=rb) , dimension(ng8) :: fracrefa
+      real(kind=rb) , dimension(ng8) :: fracrefb
+      real(kind=rb) , dimension(ng8) :: cfc12
+      real(kind=rb) , dimension(ng8) :: cfc22adj
+
+      real(kind=rb) :: ka(5,13,ng8)    ,absa(65,ng8)
+      real(kind=rb) :: kb(5,13:59,ng8) ,absb(235,ng8)
+      real(kind=rb) :: ka_mco2(19,ng8)
+      real(kind=rb) :: ka_mn2o(19,ng8)
+      real(kind=rb) :: ka_mo3(19,ng8)
+      real(kind=rb) :: kb_mco2(19,ng8)
+      real(kind=rb) :: kb_mn2o(19,ng8)
+      real(kind=rb) :: selfref(10,ng8)
+      real(kind=rb) :: forref(4,ng8)
+
+      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg08
+
Index: /palm/trunk/LIB/rrtmg/rrlw_kg09.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg09.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg09.f90	(revision 1585)
@@ -0,0 +1,78 @@
+      module rrlw_kg09
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 9
+! band 9:  1180-1390 cm-1 (low - h2o,ch4; high - ch4)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! kao_mn2o: real     
+! kbo_mn2o: real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no9  = 16
+
+      real(kind=rb) , dimension(no9) :: fracrefbo
+
+      real(kind=rb) :: fracrefao(no9,9)
+      real(kind=rb) :: kao(9,5,13,no9)
+      real(kind=rb) :: kbo(5,13:59,no9)
+      real(kind=rb) :: kao_mn2o(9,19,no9)
+      real(kind=rb) :: kbo_mn2o(19,no9)
+      real(kind=rb) :: selfrefo(10,no9)
+      real(kind=rb) :: forrefo(4,no9)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 9
+! band 9:  1180-1390 cm-1 (low - h2o,ch4; high - ch4)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real    
+! ka      : real     
+! kb      : real     
+! ka_mn2o : real     
+! kb_mn2o : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng9  = 12
+
+      real(kind=rb) , dimension(ng9) :: fracrefb
+      real(kind=rb) :: fracrefa(ng9,9)
+      real(kind=rb) :: ka(9,5,13,ng9) ,absa(585,ng9)
+      real(kind=rb) :: kb(5,13:59,ng9) ,absb(235,ng9)
+      real(kind=rb) :: ka_mn2o(9,19,ng9)
+      real(kind=rb) :: kb_mn2o(19,ng9)
+      real(kind=rb) :: selfref(10,ng9)
+      real(kind=rb) :: forref(4,ng9)
+
+      equivalence (ka(1,1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg09
Index: /palm/trunk/LIB/rrtmg/rrlw_kg10.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg10.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg10.f90	(revision 1585)
@@ -0,0 +1,71 @@
+      module rrlw_kg10
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 10
+! band 10:  1390-1480 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no10 = 16
+
+      real(kind=rb) , dimension(no10) :: fracrefao
+      real(kind=rb) , dimension(no10) :: fracrefbo
+
+      real(kind=rb) :: kao(5,13,no10)
+      real(kind=rb) :: kbo(5,13:59,no10)
+      real(kind=rb) :: selfrefo(10,no10)
+      real(kind=rb) :: forrefo(4,no10)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 10
+! band 10:  1390-1480 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng10 = 6
+
+      real(kind=rb) , dimension(ng10) :: fracrefa
+      real(kind=rb) , dimension(ng10) :: fracrefb
+
+      real(kind=rb) :: ka(5,13,ng10)   , absa(65,ng10)
+      real(kind=rb) :: kb(5,13:59,ng10), absb(235,ng10)
+      real(kind=rb) :: selfref(10,ng10)
+      real(kind=rb) :: forref(4,ng10)
+
+      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg10
Index: /palm/trunk/LIB/rrtmg/rrlw_kg11.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg11.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg11.f90	(revision 1585)
@@ -0,0 +1,79 @@
+      module rrlw_kg11
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 11
+! band 11:  1480-1800 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! kao_mo2 : real     
+! kbo_mo2 : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no11 = 16
+
+      real(kind=rb) , dimension(no11) :: fracrefao
+      real(kind=rb) , dimension(no11) :: fracrefbo
+
+      real(kind=rb) :: kao(5,13,no11)
+      real(kind=rb) :: kbo(5,13:59,no11)
+      real(kind=rb) :: kao_mo2(19,no11)
+      real(kind=rb) :: kbo_mo2(19,no11)
+      real(kind=rb) :: selfrefo(10,no11)
+      real(kind=rb) :: forrefo(4,no11)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 11
+! band 11:  1480-1800 cm-1 (low - h2o; high - h2o)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real    
+! ka      : real     
+! kb      : real     
+! ka_mo2  : real     
+! kb_mo2  : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng11 = 8
+
+      real(kind=rb) , dimension(ng11) :: fracrefa
+      real(kind=rb) , dimension(ng11) :: fracrefb
+
+      real(kind=rb) :: ka(5,13,ng11)   , absa(65,ng11)
+      real(kind=rb) :: kb(5,13:59,ng11), absb(235,ng11)
+      real(kind=rb) :: ka_mo2(19,ng11)
+      real(kind=rb) :: kb_mo2(19,ng11)
+      real(kind=rb) :: selfref(10,ng11)
+      real(kind=rb) :: forref(4,ng11)
+
+      equivalence (ka(1,1,1),absa(1,1)),(kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg11
Index: /palm/trunk/LIB/rrtmg/rrlw_kg12.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg12.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg12.f90	(revision 1585)
@@ -0,0 +1,60 @@
+      module rrlw_kg12
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 12
+! band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+! kao     : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no12 = 16
+
+      real(kind=rb) :: fracrefao(no12,9)
+      real(kind=rb) :: kao(9,5,13,no12)
+      real(kind=rb) :: selfrefo(10,no12)
+      real(kind=rb) :: forrefo(4,no12)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 12
+! band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+! ka      : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng12 = 8
+
+      real(kind=rb) :: fracrefa(ng12,9)
+      real(kind=rb) :: ka(9,5,13,ng12) ,absa(585,ng12)
+      real(kind=rb) :: selfref(10,ng12)
+      real(kind=rb) :: forref(4,ng12)
+
+      equivalence (ka(1,1,1,1),absa(1,1))
+
+      end module rrlw_kg12
Index: /palm/trunk/LIB/rrtmg/rrlw_kg13.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg13.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg13.f90	(revision 1585)
@@ -0,0 +1,76 @@
+      module rrlw_kg13
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 13
+! band 13:  2080-2250 cm-1 (low - h2o,n2o; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+! kao     : real     
+! kao_mco2: real     
+! kao_mco : real     
+! kbo_mo3 : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no13 = 16
+
+      real(kind=rb) , dimension(no13) :: fracrefbo
+
+      real(kind=rb) :: fracrefao(no13,9)
+      real(kind=rb) :: kao(9,5,13,no13)
+      real(kind=rb) :: kao_mco2(9,19,no13)
+      real(kind=rb) :: kao_mco(9,19,no13)
+      real(kind=rb) :: kbo_mo3(19,no13)
+      real(kind=rb) :: selfrefo(10,no13)
+      real(kind=rb) :: forrefo(4,no13)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 13
+! band 13:  2080-2250 cm-1 (low - h2o,n2o; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+! ka      : real     
+! ka_mco2 : real     
+! ka_mco  : real     
+! kb_mo3  : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng13 = 4
+
+      real(kind=rb) , dimension(ng13) :: fracrefb
+
+      real(kind=rb) :: fracrefa(ng13,9)
+      real(kind=rb) :: ka(9,5,13,ng13) ,absa(585,ng13)
+      real(kind=rb) :: ka_mco2(9,19,ng13)
+      real(kind=rb) :: ka_mco(9,19,ng13)
+      real(kind=rb) :: kb_mo3(19,ng13)
+      real(kind=rb) :: selfref(10,ng13)
+      real(kind=rb) :: forref(4,ng13)
+
+      equivalence (ka(1,1,1,1),absa(1,1))
+
+      end module rrlw_kg13
Index: /palm/trunk/LIB/rrtmg/rrlw_kg14.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg14.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg14.f90	(revision 1585)
@@ -0,0 +1,71 @@
+      module rrlw_kg14
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 14
+! band 14:  2250-2380 cm-1 (low - co2; high - co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+!fracrefbo: real    
+! kao     : real     
+! kbo     : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no14 = 16
+
+      real(kind=rb) , dimension(no14) :: fracrefao
+      real(kind=rb) , dimension(no14) :: fracrefbo
+
+      real(kind=rb) :: kao(5,13,no14)
+      real(kind=rb) :: kbo(5,13:59,no14)
+      real(kind=rb) :: selfrefo(10,no14)
+      real(kind=rb) :: forrefo(4,no14)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 14
+! band 14:  2250-2380 cm-1 (low - co2; high - co2)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+!fracrefb : real    
+! ka      : real     
+! kb      : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng14 = 2
+
+      real(kind=rb) , dimension(ng14) :: fracrefa
+      real(kind=rb) , dimension(ng14) :: fracrefb
+
+      real(kind=rb) :: ka(5,13,ng14)   ,absa(65,ng14)
+      real(kind=rb) :: kb(5,13:59,ng14),absb(235,ng14)
+      real(kind=rb) :: selfref(10,ng14)
+      real(kind=rb) :: forref(4,ng14)
+
+      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg14
Index: /palm/trunk/LIB/rrtmg/rrlw_kg15.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg15.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg15.f90	(revision 1585)
@@ -0,0 +1,65 @@
+      module rrlw_kg15
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 15
+! band 15:  2380-2600 cm-1 (low - n2o,co2; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+! kao     : real     
+! kao_mn2 : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no15 = 16
+
+      real(kind=rb) :: fracrefao(no15,9)
+      real(kind=rb) :: kao(9,5,13,no15)
+      real(kind=rb) :: kao_mn2(9,19,no15)
+      real(kind=rb) :: selfrefo(10,no15)
+      real(kind=rb) :: forrefo(4,no15)
+
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 15
+! band 15:  2380-2600 cm-1 (low - n2o,co2; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+! ka      : real     
+! ka_mn2  : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng15 = 2
+
+      real(kind=rb) :: fracrefa(ng15,9)
+      real(kind=rb) :: ka(9,5,13,ng15) ,absa(585,ng15)
+      real(kind=rb) :: ka_mn2(9,19,ng15)
+      real(kind=rb) :: selfref(10,ng15)
+      real(kind=rb) :: forref(4,ng15)
+
+      equivalence (ka(1,1,1,1),absa(1,1))
+
+      end module rrlw_kg15
Index: /palm/trunk/LIB/rrtmg/rrlw_kg16.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_kg16.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_kg16.f90	(revision 1585)
@@ -0,0 +1,70 @@
+      module rrlw_kg16
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------
+! rrtmg_lw ORIGINAL abs. coefficients for interval 16
+! band 16:  2600-3000 cm-1 (low - h2o,ch4; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefao: real    
+! kao     : real     
+! kbo     : real     
+! selfrefo: real     
+! forrefo : real     
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: no16 = 16
+
+      real(kind=rb) , dimension(no16) :: fracrefbo
+
+      real(kind=rb) :: fracrefao(no16,9)
+      real(kind=rb) :: kao(9,5,13,no16)
+      real(kind=rb) :: kbo(5,13:59,no16)
+      real(kind=rb) :: selfrefo(10,no16)
+      real(kind=rb) :: forrefo(4,no16)
+
+!-----------------------------------------------------------------
+! rrtmg_lw COMBINED abs. coefficients for interval 16
+! band 16:  2600-3000 cm-1 (low - h2o,ch4; high - nothing)
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!-----------------------------------------------------------------
+!
+!  name     type     purpose
+!  ----   : ----   : ---------------------------------------------
+!fracrefa : real    
+! ka      : real     
+! kb      : real     
+! selfref : real     
+! forref  : real     
+!
+! absa    : real
+! absb    : real
+!-----------------------------------------------------------------
+
+      integer(kind=im), parameter :: ng16 = 2
+
+      real(kind=rb) , dimension(ng16) :: fracrefb
+
+      real(kind=rb) :: fracrefa(ng16,9)
+      real(kind=rb) :: ka(9,5,13,ng16) ,absa(585,ng16)
+      real(kind=rb) :: kb(5,13:59,ng16), absb(235,ng16)
+      real(kind=rb) :: selfref(10,ng16)
+      real(kind=rb) :: forref(4,ng16)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrlw_kg16
+
Index: /palm/trunk/LIB/rrtmg/rrlw_ncpar.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_ncpar.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_ncpar.f90	(revision 1585)
@@ -0,0 +1,66 @@
+module rrlw_ncpar
+	use parkind ,only : im => kind_im, rb => kind_rb
+
+	implicit none
+        save
+	
+        real(kind=rb), parameter :: cpdair = 1003.5  ! Specific heat capacity of dry air
+                                        		 ! at constant pressure at 273 K
+                                        		 ! (J kg-1 K-1)
+
+	
+	integer(kind=im), parameter :: maxAbsorberNameLength = 5, &
+                          Absorber              = 12
+    character(len = maxAbsorberNameLength), dimension(Absorber), parameter :: &
+    AbsorberNames = (/        &
+     				'N2   ',  &
+     				'CCL4 ',  &
+     				'CFC11',  &
+     				'CFC12',  &
+     				'CFC22',  &
+     				'H2O  ',  &
+     				'CO2  ',  &
+     				'O3   ',  &
+     				'N2O  ',  & 
+     				'CO   ',  &
+     				'CH4  ',  &
+     				'O2   '  /)
+	
+	integer(kind=im), dimension(40) :: status
+	integer(kind=im) :: i
+	integer(kind=im), parameter :: keylower  = 9,   &
+						  keyupper  = 5,   &
+						  Tdiff     = 5,   &
+						  ps        = 59,  &
+						  plower    = 13,  &
+						  pupper    = 47,  &
+						  Tself     = 10,  &
+						  Tforeign  = 4,   &
+						  pforeign  = 4,   &
+						  T         = 19,  &
+						  Tplanck   = 181, &
+						  band      = 16,  &
+						  GPoint    = 16,  &
+						  GPointSet = 2
+						  
+	contains 
+	
+	subroutine getAbsorberIndex(AbsorberName,AbsorberIndex)
+		character(len = *), intent(in) :: AbsorberName
+		integer(kind=im), intent(out)           :: AbsorberIndex
+		
+		integer(kind=im) :: m
+	
+		AbsorberIndex = -1
+		do m = 1, Absorber
+			if (trim(AbsorberNames(m)) == trim(AbsorberName)) then
+				AbsorberIndex = m
+			end if
+		end do
+		
+		if (AbsorberIndex == -1) then
+			print*, "Absorber name index lookup failed."
+		end if
+	end subroutine getAbsorberIndex
+
+end module rrlw_ncpar
Index: /palm/trunk/LIB/rrtmg/rrlw_ref.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_ref.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_ref.f90	(revision 1585)
@@ -0,0 +1,30 @@
+      module rrlw_ref
+
+      use parkind, only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw reference atmosphere 
+! Based on standard mid-latitude summer profile
+!
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! pref   :  real   : Reference pressure levels
+! preflog:  real   : Reference pressure levels, ln(pref)
+! tref   :  real   : Reference temperature levels for MLS profile
+! chi_mls:  real   : 
+!------------------------------------------------------------------
+
+      real(kind=rb) , dimension(59) :: pref
+      real(kind=rb) , dimension(59) :: preflog
+      real(kind=rb) , dimension(59) :: tref
+      real(kind=rb) :: chi_mls(7,59)
+
+      end module rrlw_ref
Index: /palm/trunk/LIB/rrtmg/rrlw_tbl.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_tbl.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_tbl.f90	(revision 1585)
@@ -0,0 +1,46 @@
+      module rrlw_tbl
+
+      use parkind, only : im => kind_im, rb => kind_rb
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw exponential lookup table arrays
+
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, Jun 2006
+! Revised: MJIacono, AER, Aug 2007
+! Revised: MJIacono, AER, Aug 2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! ntbl   :  integer: Lookup table dimension
+! tblint :  real   : Lookup table conversion factor
+! tau_tbl:  real   : Clear-sky optical depth (used in cloudy radiative
+!                    transfer)
+! exp_tbl:  real   : Transmittance lookup table
+! tfn_tbl:  real   : Tau transition function; i.e. the transition of
+!                    the Planck function from that for the mean layer
+!                    temperature to that for the layer boundary
+!                    temperature as a function of optical depth.
+!                    The "linear in tau" method is used to make 
+!                    the table.
+! pade   :  real   : Pade constant   
+! bpade  :  real   : Inverse of Pade constant   
+!------------------------------------------------------------------
+
+      integer(kind=im), parameter :: ntbl = 10000
+
+      real(kind=rb), parameter :: tblint = 10000.0_rb
+
+      real(kind=rb) , dimension(0:ntbl) :: tau_tbl
+      real(kind=rb) , dimension(0:ntbl) :: exp_tbl
+      real(kind=rb) , dimension(0:ntbl) :: tfn_tbl
+
+      real(kind=rb), parameter :: pade = 0.278_rb
+      real(kind=rb) :: bpade
+
+      end module rrlw_tbl
+
Index: /palm/trunk/LIB/rrtmg/rrlw_vsn.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_vsn.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_vsn.f90	(revision 1585)
@@ -0,0 +1,54 @@
+      module rrlw_vsn
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw version information
+
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+!hnamrtm :character: 
+!hnamini :character: 
+!hnamcld :character: 
+!hnamclc :character: 
+!hnamrtr :character: 
+!hnamrtx :character: 
+!hnamrtc :character: 
+!hnamset :character: 
+!hnamtau :character: 
+!hnamatm :character: 
+!hnamutl :character: 
+!hnamext :character: 
+!hnamkg  :character: 
+!
+! hvrrtm :character: 
+! hvrini :character: 
+! hvrcld :character: 
+! hvrclc :character: 
+! hvrrtr :character: 
+! hvrrtx :character: 
+! hvrrtc :character: 
+! hvrset :character: 
+! hvrtau :character: 
+! hvratm :character: 
+! hvrutl :character: 
+! hvrext :character: 
+! hvrkg  :character: 
+!------------------------------------------------------------------
+
+      character*18 hvrrtm,hvrini,hvrcld,hvrclc,hvrrtr,hvrrtx, &
+                   hvrrtc,hvrset,hvrtau,hvratm,hvrutl,hvrext
+      character*20 hnamrtm,hnamini,hnamcld,hnamclc,hnamrtr,hnamrtx, &
+                   hnamrtc,hnamset,hnamtau,hnamatm,hnamutl,hnamext
+
+      character*18 hvrkg
+      character*20 hnamkg
+
+      end module rrlw_vsn
+
Index: /palm/trunk/LIB/rrtmg/rrlw_wvn.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrlw_wvn.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrlw_wvn.f90	(revision 1585)
@@ -0,0 +1,86 @@
+      module rrlw_wvn
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : nbndlw, mg, ngptlw, maxinpx
+
+      implicit none
+      save
+
+!------------------------------------------------------------------
+! rrtmg_lw spectral information
+
+! Initial version:  JJMorcrette, ECMWF, jul1998
+! Revised: MJIacono, AER, jun2006
+! Revised: MJIacono, AER, aug2008
+!------------------------------------------------------------------
+
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! ng     :  integer: Number of original g-intervals in each spectral band
+! nspa   :  integer: For the lower atmosphere, the number of reference
+!                    atmospheres that are stored for each spectral band
+!                    per pressure level and temperature.  Each of these
+!                    atmospheres has different relative amounts of the 
+!                    key species for the band (i.e. different binary
+!                    species parameters).
+! nspb   :  integer: Same as nspa for the upper atmosphere
+!wavenum1:  real   : Spectral band lower boundary in wavenumbers
+!wavenum2:  real   : Spectral band upper boundary in wavenumbers
+! delwave:  real   : Spectral band width in wavenumbers
+! totplnk:  real   : Integrated Planck value for each band; (band 16
+!                    includes total from 2600 cm-1 to infinity)
+!                    Used for calculation across total spectrum
+!totplk16:  real   : Integrated Planck value for band 16 (2600-3250 cm-1)
+!                    Used for calculation in band 16 only if 
+!                    individual band output requested
+!totplnkderiv: real: Integrated Planck function derivative with respect
+!                    to temperature for each band; (band 16
+!                    includes total from 2600 cm-1 to infinity)
+!                    Used for calculation across total spectrum
+!totplk16deriv:real: Integrated Planck function derivative with respect
+!                    to temperature for band 16 (2600-3250 cm-1)
+!                    Used for calculation in band 16 only if 
+!                    individual band output requested
+!
+! ngc    :  integer: The number of new g-intervals in each band
+! ngs    :  integer: The cumulative sum of new g-intervals for each band
+! ngm    :  integer: The index of each new g-interval relative to the
+!                    original 16 g-intervals in each band
+! ngn    :  integer: The number of original g-intervals that are 
+!                    combined to make each new g-intervals in each band
+! ngb    :  integer: The band index for each new g-interval
+! wt     :  real   : RRTM weights for the original 16 g-intervals
+! rwgt   :  real   : Weights for combining original 16 g-intervals 
+!                    (256 total) into reduced set of g-intervals 
+!                    (140 total)
+! nxmol  :  integer: Number of cross-section molecules
+! ixindx :  integer: Flag for active cross-sections in calculation
+!------------------------------------------------------------------
+
+      integer(kind=im) :: ng(nbndlw)
+      integer(kind=im) :: nspa(nbndlw)
+      integer(kind=im) :: nspb(nbndlw)
+
+      real(kind=rb) :: wavenum1(nbndlw)
+      real(kind=rb) :: wavenum2(nbndlw)
+      real(kind=rb) :: delwave(nbndlw)
+
+      real(kind=rb) :: totplnk(181,nbndlw)
+      real(kind=rb) :: totplk16(181)
+
+      real(kind=rb) :: totplnkderiv(181,nbndlw)
+      real(kind=rb) :: totplk16deriv(181)
+
+      integer(kind=im) :: ngc(nbndlw)
+      integer(kind=im) :: ngs(nbndlw)
+      integer(kind=im) :: ngn(ngptlw)
+      integer(kind=im) :: ngb(ngptlw)
+      integer(kind=im) :: ngm(nbndlw*mg)
+
+      real(kind=rb) :: wt(mg)
+      real(kind=rb) :: rwgt(nbndlw*mg)
+
+      integer(kind=im) :: nxmol
+      integer(kind=im) :: ixindx(maxinpx)
+
+      end module rrlw_wvn
Index: /palm/trunk/LIB/rrtmg/rrsw_aer.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_aer.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_aer.f90	(revision 1585)
@@ -0,0 +1,60 @@
+      module rrsw_aer
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=rb) :: rsrtaua(nbndsw,naerec)
+      real(kind=rb) :: rsrpiza(nbndsw,naerec)
+      real(kind=rb) :: rsrasya(nbndsw,naerec)
+
+      end module rrsw_aer
+
Index: /palm/trunk/LIB/rrtmg/rrsw_cld.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_cld.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_cld.f90	(revision 1585)
@@ -0,0 +1,47 @@
+      module rrsw_cld
+
+      use parkind, only : im => kind_im, rb => kind_rb
+
+      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
+! Revised: MJIacono, AER, dec2013: Updated xxxliq1 look-up tables
+!------------------------------------------------------------------
+!
+!  name     type     purpose
+! -----  :  ----   : ----------------------------------------------
+! xxxliq1 : real   : optical properties (extinction coefficient, single 
+!                    scattering albedo, assymetry factor) based on 
+!                    Hu & Stamnes, j. clim., 6, 728-742, 1993. Derived
+!                    from Mie scattering calculations at higher spectral
+!                    resolution than Hu & Stamnes. Used in CIRC (Continuous
+!                    Intercomparison of Radiation Codes) project. 
+! 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(kind=rb) :: extliq1(58,16:29), ssaliq1(58,16:29), asyliq1(58,16:29)
+      real(kind=rb) :: extice2(43,16:29), ssaice2(43,16:29), asyice2(43,16:29)
+      real(kind=rb) :: extice3(46,16:29), ssaice3(46,16:29), asyice3(46,16:29)
+      real(kind=rb) :: fdlice3(46,16:29)
+      real(kind=rb) :: abari(5),bbari(5),cbari(5),dbari(5),ebari(5),fbari(5)
+
+      end module rrsw_cld
+
Index: /palm/trunk/LIB/rrtmg/rrsw_con.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_con.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_con.f90	(revision 1585)
@@ -0,0 +1,42 @@
+      module rrsw_con
+
+      use parkind, only : im => kind_im, rb => kind_rb
+
+      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(kind=rb) :: fluxfac, heatfac
+      real(kind=rb) :: oneminus, pi, grav
+      real(kind=rb) :: planck, boltz, clight
+      real(kind=rb) :: avogad, alosmt, gascon
+      real(kind=rb) :: radcn1, radcn2
+      real(kind=rb) :: sbcnst, secdy
+
+      end module rrsw_con
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg16.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg16.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg16.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrsw_kg16
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no16 = 16
+
+      real(kind=rb) :: kao(9,5,13,no16)
+      real(kind=rb) :: kbo(5,13:59,no16)
+      real(kind=rb) :: selfrefo(10,no16), forrefo(3,no16)
+      real(kind=rb) :: sfluxrefo(no16)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng16) , absa(585,ng16)
+      real(kind=rb) :: kb(5,13:59,ng16), absb(235,ng16)
+      real(kind=rb) :: selfref(10,ng16), forref(3,ng16)
+      real(kind=rb) :: sfluxref(ng16)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg16
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg17.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg17.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg17.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrsw_kg17
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no17 = 16
+
+      real(kind=rb) :: kao(9,5,13,no17)
+      real(kind=rb) :: kbo(5,5,13:59,no17)
+      real(kind=rb) :: selfrefo(10,no17), forrefo(4,no17)
+      real(kind=rb) :: sfluxrefo(no17,5)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng17) , absa(585,ng17)
+      real(kind=rb) :: kb(5,5,13:59,ng17), absb(1175,ng17)
+      real(kind=rb) :: selfref(10,ng17), forref(4,ng17)
+      real(kind=rb) :: sfluxref(ng17,5)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,1,13,1),absb(1,1))
+
+      end module rrsw_kg17
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg18.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg18.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg18.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrsw_kg18
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no18 = 16
+
+      real(kind=rb) :: kao(9,5,13,no18)
+      real(kind=rb) :: kbo(5,13:59,no18)
+      real(kind=rb) :: selfrefo(10,no18), forrefo(3,no18)
+      real(kind=rb) :: sfluxrefo(no18,9)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng18), absa(585,ng18)
+      real(kind=rb) :: kb(5,13:59,ng18), absb(235,ng18)
+      real(kind=rb) :: selfref(10,ng18), forref(3,ng18)
+      real(kind=rb) :: sfluxref(ng18,9)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg18
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg19.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg19.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg19.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrsw_kg19
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no19 = 16
+
+      real(kind=rb) :: kao(9,5,13,no19)
+      real(kind=rb) :: kbo(5,13:59,no19)
+      real(kind=rb) :: selfrefo(10,no19), forrefo(3,no19)
+      real(kind=rb) :: sfluxrefo(no19,9)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng19), absa(585,ng19)
+      real(kind=rb) :: kb(5,13:59,ng19), absb(235,ng19)
+      real(kind=rb) :: selfref(10,ng19), forref(3,ng19)
+      real(kind=rb) :: sfluxref(ng19,9)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg19
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg20.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg20.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg20.f90	(revision 1585)
@@ -0,0 +1,68 @@
+      module rrsw_kg20
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no20 = 16
+
+      real(kind=rb) :: kao(5,13,no20)
+      real(kind=rb) :: kbo(5,13:59,no20)
+      real(kind=rb) :: selfrefo(10,no20), forrefo(4,no20)
+      real(kind=rb) :: sfluxrefo(no20)
+      real(kind=rb) :: absch4o(no20)
+
+      real(kind=rb) :: 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(kind=rb) :: ka(5,13,ng20), absa(65,ng20)
+      real(kind=rb) :: kb(5,13:59,ng20), absb(235,ng20)
+      real(kind=rb) :: selfref(10,ng20), forref(4,ng20)
+      real(kind=rb) :: sfluxref(ng20)
+      real(kind=rb) :: absch4(ng20)
+
+      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg20
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg21.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg21.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg21.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrsw_kg21
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no21 = 16
+
+      real(kind=rb) :: kao(9,5,13,no21)
+      real(kind=rb) :: kbo(5,5,13:59,no21)
+      real(kind=rb) :: selfrefo(10,no21), forrefo(4,no21)
+      real(kind=rb) :: sfluxrefo(no21,9)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng21), absa(585,ng21)
+      real(kind=rb) :: kb(5,5,13:59,ng21), absb(1175,ng21)
+      real(kind=rb) :: selfref(10,ng21), forref(4,ng21)
+      real(kind=rb) :: sfluxref(ng21,9)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,1,13,1),absb(1,1))
+
+      end module rrsw_kg21
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg22.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg22.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg22.f90	(revision 1585)
@@ -0,0 +1,64 @@
+      module rrsw_kg22
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no22 = 16
+
+      real(kind=rb) :: kao(9,5,13,no22)
+      real(kind=rb) :: kbo(5,13:59,no22)
+      real(kind=rb) :: selfrefo(10,no22), forrefo(3,no22)
+      real(kind=rb) :: sfluxrefo(no22,9)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng22), absa(585,ng22)
+      real(kind=rb) :: kb(5,13:59,ng22), absb(235,ng22)
+      real(kind=rb) :: selfref(10,ng22), forref(3,ng22)
+      real(kind=rb) :: sfluxref(ng22,9)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg22
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg23.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg23.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg23.f90	(revision 1585)
@@ -0,0 +1,61 @@
+      module rrsw_kg23
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no23 = 16
+
+      real(kind=rb) :: kao(5,13,no23)
+      real(kind=rb) :: selfrefo(10,no23), forrefo(3,no23)
+      real(kind=rb) :: sfluxrefo(no23)
+      real(kind=rb) :: raylo(no23)
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(5,13,ng23), absa(65,ng23)
+      real(kind=rb) :: selfref(10,ng23), forref(3,ng23)
+      real(kind=rb) :: sfluxref(ng23), rayl(ng23)
+
+      equivalence (ka(1,1,1),absa(1,1))
+
+      end module rrsw_kg23
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg24.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg24.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg24.f90	(revision 1585)
@@ -0,0 +1,74 @@
+      module rrsw_kg24
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no24 = 16
+
+      real(kind=rb) :: kao(9,5,13,no24)
+      real(kind=rb) :: kbo(5,13:59,no24)
+      real(kind=rb) :: selfrefo(10,no24), forrefo(3,no24)
+      real(kind=rb) :: sfluxrefo(no24,9)
+      real(kind=rb) :: abso3ao(no24), abso3bo(no24)
+      real(kind=rb) :: raylao(no24,9), raylbo(no24)
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng24), absa(585,ng24)
+      real(kind=rb) :: kb(5,13:59,ng24), absb(235,ng24)
+      real(kind=rb) :: selfref(10,ng24), forref(3,ng24)
+      real(kind=rb) :: sfluxref(ng24,9)
+      real(kind=rb) :: abso3a(ng24), abso3b(ng24)
+      real(kind=rb) :: 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
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg25.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg25.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg25.f90	(revision 1585)
@@ -0,0 +1,61 @@
+      module rrsw_kg25
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no25 = 16
+
+      real(kind=rb) :: kao(5,13,no25)
+      real(kind=rb) :: sfluxrefo(no25)
+      real(kind=rb) :: abso3ao(no25), abso3bo(no25)
+      real(kind=rb) :: raylo(no25)
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(5,13,ng25), absa(65,ng25)
+      real(kind=rb) :: sfluxref(ng25)
+      real(kind=rb) :: abso3a(ng25), abso3b(ng25)
+      real(kind=rb) :: rayl(ng25)
+
+      equivalence (ka(1,1,1),absa(1,1))
+
+      end module rrsw_kg25
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg26.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg26.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg26.f90	(revision 1585)
@@ -0,0 +1,48 @@
+      module rrsw_kg26
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no26 = 16
+
+      real(kind=rb) :: sfluxrefo(no26)
+      real(kind=rb) :: 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(kind=rb) :: sfluxref(ng26)
+      real(kind=rb) :: rayl(ng26)
+
+      end module rrsw_kg26
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg27.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg27.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg27.f90	(revision 1585)
@@ -0,0 +1,60 @@
+      module rrsw_kg27
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no27 = 16
+
+      real(kind=rb) :: kao(5,13,no27)
+      real(kind=rb) :: kbo(5,13:59,no27)
+      real(kind=rb) :: sfluxrefo(no27)
+      real(kind=rb) :: raylo(no27)
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(5,13,ng27), absa(65,ng27)
+      real(kind=rb) :: kb(5,13:59,ng27), absb(235,ng27)
+      real(kind=rb) :: sfluxref(ng27)
+      real(kind=rb) :: rayl(ng27)
+
+      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg27
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg28.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg28.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg28.f90	(revision 1585)
@@ -0,0 +1,56 @@
+      module rrsw_kg28
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no28 = 16
+
+      real(kind=rb) :: kao(9,5,13,no28)
+      real(kind=rb) :: kbo(5,5,13:59,no28)
+      real(kind=rb) :: sfluxrefo(no28,5)
+
+      real(kind=rb) :: rayl
+
+!-----------------------------------------------------------------
+! 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(kind=rb) :: ka(9,5,13,ng28), absa(585,ng28)
+      real(kind=rb) :: kb(5,5,13:59,ng28), absb(1175,ng28)
+      real(kind=rb) :: sfluxref(ng28,5)
+
+      equivalence (ka(1,1,1,1),absa(1,1)), (kb(1,1,13,1),absb(1,1))
+
+      end module rrsw_kg28
+
Index: /palm/trunk/LIB/rrtmg/rrsw_kg29.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_kg29.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_kg29.f90	(revision 1585)
@@ -0,0 +1,68 @@
+      module rrsw_kg29
+
+      use parkind ,only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im), parameter :: no29 = 16
+
+      real(kind=rb) :: kao(5,13,no29)
+      real(kind=rb) :: kbo(5,13:59,no29)
+      real(kind=rb) :: selfrefo(10,no29), forrefo(4,no29)
+      real(kind=rb) :: sfluxrefo(no29)
+      real(kind=rb) :: absh2oo(no29), absco2o(no29)
+
+      real(kind=rb) :: 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(kind=rb) :: ka(5,13,ng29), absa(65,ng29)
+      real(kind=rb) :: kb(5,13:59,ng29), absb(235,ng29)
+      real(kind=rb) :: selfref(10,ng29), forref(4,ng29)
+      real(kind=rb) :: sfluxref(ng29)
+      real(kind=rb) :: absh2o(ng29), absco2(ng29)
+
+      equivalence (ka(1,1,1),absa(1,1)), (kb(1,13,1),absb(1,1))
+
+      end module rrsw_kg29
+
Index: /palm/trunk/LIB/rrtmg/rrsw_ncpar.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_ncpar.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_ncpar.f90	(revision 1585)
@@ -0,0 +1,105 @@
+module rrsw_ncpar
+	use parkind ,only : im => kind_im, rb => kind_rb
+
+	implicit none
+    save
+	
+    real(kind=rb), parameter :: cpdair = 1003.5  ! Specific heat capacity of dry air
+                                        		 ! at constant pressure at 273 K
+                                        		 ! (J kg-1 K-1)
+
+	integer(kind=im), dimension(50) :: status
+	integer(kind=im) :: i
+	integer(kind=im), parameter :: keylower      = 9,  &
+						  keyupper      = 5,  &
+						  Tdiff         = 5,  &
+						  ps            = 59, &
+						  plower        = 13, &
+						  pupper        = 47, &
+						  Tself         = 10, &
+						  Tforeignlower = 3,  &
+						  Tforeignupper = 2,  &
+						  pforeign      = 4,  &
+						  T             = 19, &
+						  band          = 14, &
+						  GPoint        = 16, &
+						  GPointSet     = 2
+	
+	integer(kind=im), parameter :: maxAbsorberNameLength   = 5,  &
+                          Absorber                = 12, &
+                          maxKeySpeciesNameLength = 3,  &
+                          maxKeySpeciesNames      = 2
+                          
+    character(len = maxAbsorberNameLength), dimension(Absorber), parameter :: &
+    AbsorberNames = (/        &
+     				'N2   ',  &
+     				'CCL4 ',  &
+     				'CFC11',  &
+     				'CFC12',  &
+     				'CFC22',  &
+     				'H2O  ',  &
+     				'CO2  ',  &
+     				'O3   ',  &
+     				'N2O  ',  & 
+     				'CO   ',  &
+     				'CH4  ',  &
+     				'O2   '  /)
+	
+	character(len = maxKeySpeciesNameLength), dimension(band,maxKeySpeciesNames), parameter :: &
+    KeySpeciesNamesLower = RESHAPE( SOURCE = (/ 'H2O', 'H2O', 'H2O', 'H2O', 'H2O', 'H2O', 'H2O', &
+							  					'H2O', 'H2O', 'H2O', '   ', 'O3 ', 'O3 ', 'H2O', &
+							  					'CH4', 'CO2', 'CH4', 'CO2', '   ', 'CO2', 'O2 ', &
+							  					'   ', 'O2 ', '   ', '   ', '   ', 'O2 ', '   '  /), &
+							  		SHAPE = (/ band, maxKeySpeciesNames /) )
+							  
+	character(len = maxKeySpeciesNameLength), dimension(band,maxKeySpeciesNames), parameter :: &
+    KeySpeciesNamesUpper = RESHAPE( SOURCE = (/ 'CH4', 'H2O', 'CH4', 'CO2', 'H2O', 'H2O', 'O2 ', &
+							 					'   ', 'O2 ', '   ', '   ', 'O3 ', 'O3 ', 'CO2', &
+							  					'   ', 'CO2', '   ', '   ', '   ', 'CO2', '   ', &
+							  					'   ', '   ', '   ', '   ', '   ', 'O2 ', '   '  /), &
+							  		SHAPE = (/ band, maxKeySpeciesNames /) )
+							
+	integer(kind=im), dimension(band)     :: BandNums = (/ 16, 17, 18, 19, 20, 21, 22, &
+										  		        23, 24, 25, 26, 27, 28, 29 /)
+										      
+	real(kind=rb), dimension(keylower) :: KeySpeciesLower = (/ 1.0, 0.125, 0.25, 0.375, &
+											      			   0.50, 0.625, 0.75, 0.875, 1.0 /)
+											          
+	real(kind=rb), dimension(keyupper) :: KeySpeciesUpper = (/ 0.0, 0.25, 0.50, 0.75, 1.0 /)
+		
+	real(kind=rb), dimension(Tdiff)    :: TempDiffs = (/ -30, -15, 0, 15, 30 /)
+										      
+	real(kind=rb), dimension(Tself)    :: TempSelf = (/ 245.6,252.8,260.0,267.2,274.4, &
+														281.6,288.8,296.0,303.2,310.4 /)		
+	
+	real(kind=rb), dimension(Tforeignlower) :: TempForeignlower = (/ 296, 260, 224 /)
+	
+	real(kind=rb), dimension(Tforeignupper) :: TempForeignupper = (/ 224, 260 /)
+	
+	real(kind=rb), dimension(pforeign) :: PressForeign = (/ 970, 475, 219, 3 /)
+			
+	real(kind=rb), dimension(T)        :: Temp = (/188.0, 195.2, 202.4, 209.6, 216.8, 224.0, &
+								   				   231.2, 238.4, 245.6, 252.8, 260.0, 267.2, &
+								   				   274.4, 281.6, 288.8, 296.0, 303.2, 310.4, 317.6 /)
+	
+	contains 
+	
+	subroutine getAbsorberIndex(AbsorberName,AbsorberIndex)
+		character(len = *), intent(in) :: AbsorberName
+		integer(kind=im), intent(out)           :: AbsorberIndex
+		
+		integer(kind=im) :: m
+	
+		AbsorberIndex = -1
+		do m = 1, Absorber
+			if (trim(AbsorberNames(m)) == trim(AbsorberName)) then
+				AbsorberIndex = m
+			end if
+		end do
+		
+		if (AbsorberIndex == -1) then
+			print*, "Absorber name index lookup failed."
+		end if
+	end subroutine getAbsorberIndex
+
+end module rrsw_ncpar
Index: /palm/trunk/LIB/rrtmg/rrsw_ref.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_ref.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_ref.f90	(revision 1585)
@@ -0,0 +1,28 @@
+      module rrsw_ref
+
+      use parkind, only : im => kind_im, rb => kind_rb
+
+      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(kind=rb) , dimension(59) :: pref
+      real(kind=rb) , dimension(59) :: preflog
+      real(kind=rb) , dimension(59) :: tref
+
+      end module rrsw_ref
Index: /palm/trunk/LIB/rrtmg/rrsw_tbl.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_tbl.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_tbl.f90	(revision 1585)
@@ -0,0 +1,41 @@
+      module rrsw_tbl
+
+      use parkind, only : im => kind_im, rb => kind_rb
+
+      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(kind=im), parameter :: ntbl = 10000
+
+      real(kind=rb), parameter :: tblint = 10000.0_rb
+
+      real(kind=rb), parameter :: od_lo = 0.06_rb
+
+      real(kind=rb) :: tau_tbl
+      real(kind=rb) , dimension(0:ntbl) :: exp_tbl
+
+      real(kind=rb), parameter :: pade = 0.278_rb
+      real(kind=rb) :: bpade
+
+      end module rrsw_tbl
+
Index: /palm/trunk/LIB/rrtmg/rrsw_vsn.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_vsn.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_vsn.f90	(revision 1585)
@@ -0,0 +1,56 @@
+      module rrsw_vsn
+
+      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
+
Index: /palm/trunk/LIB/rrtmg/rrsw_wvn.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrsw_wvn.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrsw_wvn.f90	(revision 1585)
@@ -0,0 +1,56 @@
+      module rrsw_wvn
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, 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(kind=im) :: ng(jpb1:jpb2)
+      integer(kind=im) :: nspa(jpb1:jpb2)
+      integer(kind=im) :: nspb(jpb1:jpb2)
+
+      real(kind=rb) :: wavenum1(jpb1:jpb2)
+      real(kind=rb) :: wavenum2(jpb1:jpb2)
+      real(kind=rb) :: delwave(jpb1:jpb2)
+
+      integer(kind=im) :: ngc(nbndsw)
+      integer(kind=im) :: ngs(nbndsw)
+      integer(kind=im) :: ngn(ngptsw)
+      integer(kind=im) :: ngb(ngptsw)
+      integer(kind=im) :: ngm(nbndsw*mg)
+
+      real(kind=rb) :: wt(mg)
+      real(kind=rb) :: rwgt(nbndsw*mg)
+
+      end module rrsw_wvn
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_cldprmc.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_cldprmc.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_cldprmc.f90	(revision 1585)
@@ -0,0 +1,256 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_cldprmc.f90,v $
+!     author:    $Author: miacono $
+!     revision:  $Revision: 1.9 $
+!     created:   $Date: 2011/04/08 20:25:00 $
+!
+      module rrtmg_lw_cldprmc
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! --------- Modules ----------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : ngptlw, nbndlw
+      use rrlw_cld, only: abscld1, absliq0, absliq1, &
+                          absice0, absice1, absice2, absice3
+      use rrlw_wvn, only: ngb
+      use rrlw_vsn, only: hvrclc, hnamclc
+
+      implicit none
+
+      contains
+
+! ------------------------------------------------------------------------------
+      subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, &
+                         ciwpmc, clwpmc, reicmc, relqmc, ncbands, taucmc)
+! ------------------------------------------------------------------------------
+
+! Purpose:  Compute the cloud optical depth(s) for each cloudy layer.
+
+! ------- Input -------
+
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: inflag          ! see definitions
+      integer(kind=im), intent(in) :: iceflag         ! see definitions
+      integer(kind=im), intent(in) :: liqflag         ! see definitions
+
+      real(kind=rb), intent(in) :: cldfmc(:,:)        ! cloud fraction [mcica]
+                                                      !    Dimensions: (ngptlw,nlayers)
+      real(kind=rb), intent(in) :: ciwpmc(:,:)        ! cloud ice water path [mcica]
+                                                      !    Dimensions: (ngptlw,nlayers)
+      real(kind=rb), intent(in) :: clwpmc(:,:)        ! cloud liquid water path [mcica]
+                                                      !    Dimensions: (ngptlw,nlayers)
+      real(kind=rb), intent(in) :: relqmc(:)          ! liquid particle effective radius (microns)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: reicmc(:)          ! ice particle effective radius (microns)
+                                                      !    Dimensions: (nlayers)
+                                                      ! specific definition of reicmc depends on setting of iceflag:
+                                                      ! iceflag = 0: ice effective radius, r_ec, (Ebert and Curry, 1992),
+                                                      !              r_ec must be >= 10.0 microns
+                                                      ! iceflag = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
+                                                      !              r_ec range is limited to 13.0 to 130.0 microns
+                                                      ! iceflag = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
+                                                      !              r_k range is limited to 5.0 to 131.0 microns
+                                                      ! iceflag = 3: generalized effective size, dge, (Fu, 1996),
+                                                      !              dge range is limited to 5.0 to 140.0 microns
+                                                      !              [dge = 1.0315 * r_ec]
+
+! ------- Output -------
+
+      integer(kind=im), intent(out) :: ncbands        ! number of cloud spectral bands
+      real(kind=rb), intent(inout) :: taucmc(:,:)     ! cloud optical depth [mcica]
+                                                      !    Dimensions: (ngptlw,nlayers)
+
+! ------- Local -------
+
+      integer(kind=im) :: lay                         ! Layer index
+      integer(kind=im) :: ib                          ! spectral band index
+      integer(kind=im) :: ig                          ! g-point interval index
+      integer(kind=im) :: index 
+      integer(kind=im) :: icb(nbndlw)
+
+      real(kind=rb) :: abscoice(ngptlw)               ! ice absorption coefficients
+      real(kind=rb) :: abscoliq(ngptlw)               ! liquid absorption coefficients
+      real(kind=rb) :: cwp                            ! cloud water path
+      real(kind=rb) :: radice                         ! cloud ice effective size (microns)
+      real(kind=rb) :: factor                         ! 
+      real(kind=rb) :: fint                           ! 
+      real(kind=rb) :: radliq                         ! cloud liquid droplet radius (microns)
+      real(kind=rb), parameter :: eps = 1.e-6_rb      ! epsilon
+      real(kind=rb), parameter :: cldmin = 1.e-20_rb  ! minimum value for cloud quantities
+
+! ------- Definitions -------
+
+!     Explanation of the method for each value of INFLAG.  Values of
+!     0 or 1 for INFLAG do not distingish being liquid and ice clouds.
+!     INFLAG = 2 does distinguish between liquid and ice clouds, and
+!     requires further user input to specify the method to be used to 
+!     compute the aborption due to each.
+!     INFLAG = 0:  For each cloudy layer, the cloud fraction and (gray)
+!                  optical depth are input.  
+!     INFLAG = 1:  For each cloudy layer, the cloud fraction and cloud
+!                  water path (g/m2) are input.  The (gray) cloud optical 
+!                  depth is computed as in CCM2.
+!     INFLAG = 2:  For each cloudy layer, the cloud fraction, cloud 
+!                  water path (g/m2), and cloud ice fraction are input.
+!       ICEFLAG = 0:  The ice effective radius (microns) is input and the
+!                     optical depths due to ice clouds are computed as in CCM3.
+!       ICEFLAG = 1:  The ice effective radius (microns) is input and the
+!                     optical depths due to ice clouds are computed as in 
+!                     Ebert and Curry, JGR, 97, 3831-3836 (1992).  The 
+!                     spectral regions in this work have been matched with
+!                     the spectral bands in RRTM to as great an extent 
+!                     as possible:  
+!                     E&C 1      IB = 5      RRTM bands 9-16
+!                     E&C 2      IB = 4      RRTM bands 6-8
+!                     E&C 3      IB = 3      RRTM bands 3-5
+!                     E&C 4      IB = 2      RRTM band 2
+!                     E&C 5      IB = 1      RRTM band 1
+!       ICEFLAG = 2:  The ice effective radius (microns) is input and the
+!                     optical properties due to ice clouds are computed from
+!                     the optical properties stored in the RT code,
+!                     STREAMER v3.0 (Reference: Key. J., Streamer 
+!                     User's Guide, Cooperative Institute for
+!                     Meteorological Satellite Studies, 2001, 96 pp.).
+!                     Valid range of values for re are between 5.0 and
+!                     131.0 micron.
+!       ICEFLAG = 3: The ice generalized effective size (dge) is input
+!                    and the optical properties, are calculated as in
+!                    Q. Fu, J. Climate, (1998). Q. Fu provided high resolution
+!                    tables which were appropriately averaged for the
+!                    bands in RRTM_LW.  Linear interpolation is used to
+!                    get the coefficients from the stored tables.
+!                    Valid range of values for dge are between 5.0 and
+!                    140.0 micron.
+!       LIQFLAG = 0:  The optical depths due to water clouds are computed as
+!                     in CCM3.
+!       LIQFLAG = 1:  The water droplet effective radius (microns) is input 
+!                     and the optical depths due to water clouds are computed 
+!                     as in Hu and Stamnes, J., Clim., 6, 728-742, (1993).
+!                     The values for absorption coefficients appropriate for
+!                     the spectral bands in RRTM have been obtained for a 
+!                     range of effective radii by an averaging procedure 
+!                     based on the work of J. Pinto (private communication).
+!                     Linear interpolation is used to get the absorption 
+!                     coefficients for the input effective radius.
+
+      data icb /1,2,3,3,3,4,4,4,5, 5, 5, 5, 5, 5, 5, 5/
+
+      hvrclc = '$Revision: 1.9 $'
+
+      ncbands = 1
+
+! This initialization is done in rrtmg_lw_subcol.F90.
+!      do lay = 1, nlayers
+!         do ig = 1, ngptlw
+!            taucmc(ig,lay) = 0.0_rb
+!         enddo
+!      enddo
+
+! Main layer loop
+      do lay = 1, nlayers
+
+        do ig = 1, ngptlw
+          cwp = ciwpmc(ig,lay) + clwpmc(ig,lay)
+          if (cldfmc(ig,lay) .ge. cldmin .and. &
+             (cwp .ge. cldmin .or. taucmc(ig,lay) .ge. cldmin)) then
+
+! Ice clouds and water clouds combined.
+            if (inflag .eq. 0) then
+! Cloud optical depth already defined in taucmc, return to main program
+               return
+
+            elseif(inflag .eq. 1) then 
+                stop 'INFLAG = 1 OPTION NOT AVAILABLE WITH MCICA'
+!               cwp = ciwpmc(ig,lay) + clwpmc(ig,lay)
+!               taucmc(ig,lay) = abscld1 * cwp
+
+! Separate treatement of ice clouds and water clouds.
+            elseif(inflag .eq. 2) then
+               radice = reicmc(lay)
+
+! Calculation of absorption coefficients due to ice clouds.
+               if (ciwpmc(ig,lay) .eq. 0.0_rb) then
+                  abscoice(ig) = 0.0_rb
+
+               elseif (iceflag .eq. 0) then
+                  if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL'
+                  abscoice(ig) = absice0(1) + absice0(2)/radice
+
+               elseif (iceflag .eq. 1) then
+                  if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop &
+                      'ICE RADIUS OUT OF BOUNDS'
+                  ncbands = 5
+                  ib = icb(ngb(ig))
+                  abscoice(ig) = absice1(1,ib) + absice1(2,ib)/radice
+
+! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns
+
+               elseif (iceflag .eq. 2) then
+                  if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop 'ICE RADIUS OUT OF BOUNDS'
+                     ncbands = 16
+                     factor = (radice - 2._rb)/3._rb
+                     index = int(factor)
+                     if (index .eq. 43) index = 42
+                     fint = factor - real(index)
+                     ib = ngb(ig)
+                     abscoice(ig) = &
+                         absice2(index,ib) + fint * &
+                         (absice2(index+1,ib) - (absice2(index,ib))) 
+               
+! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns
+
+               elseif (iceflag .eq. 3) then
+                  if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) stop 'ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS'
+                     ncbands = 16
+                     factor = (radice - 2._rb)/3._rb
+                     index = int(factor)
+                     if (index .eq. 46) index = 45
+                     fint = factor - real(index)
+                     ib = ngb(ig)
+                     abscoice(ig) = &
+                         absice3(index,ib) + fint * &
+                         (absice3(index+1,ib) - (absice3(index,ib)))
+   
+               endif
+                  
+! Calculation of absorption coefficients due to water clouds.
+               if (clwpmc(ig,lay) .eq. 0.0_rb) then
+                  abscoliq(ig) = 0.0_rb
+
+               elseif (liqflag .eq. 0) then
+                   abscoliq(ig) = absliq0
+
+               elseif (liqflag .eq. 1) then
+                  radliq = relqmc(lay)
+                  if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) stop &
+                       'LIQUID EFFECTIVE RADIUS OUT OF BOUNDS'
+                  index = int(radliq - 1.5_rb)
+                  if (index .eq. 0) index = 1
+                  if (index .eq. 58) index = 57
+                  fint = radliq - 1.5_rb - real(index)
+                  ib = ngb(ig)
+                  abscoliq(ig) = &
+                        absliq1(index,ib) + fint * &
+                        (absliq1(index+1,ib) - (absliq1(index,ib)))
+               endif
+
+               taucmc(ig,lay) = ciwpmc(ig,lay) * abscoice(ig) + &
+                                clwpmc(ig,lay) * abscoliq(ig)
+
+            endif
+         endif
+         enddo
+      enddo
+
+      end subroutine cldprmc
+
+      end module rrtmg_lw_cldprmc
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_cldprop.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_cldprop.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_cldprop.f90	(revision 1585)
@@ -0,0 +1,278 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_cldprop.f90,v $
+!     author:    $Author: miacono $
+!     revision:  $Revision: 1.9 $
+!     created:   $Date: 2011/04/08 20:25:00 $
+!
+      module rrtmg_lw_cldprop
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! --------- Modules ----------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : nbndlw
+      use rrlw_cld, only: abscld1, absliq0, absliq1, &
+                          absice0, absice1, absice2, absice3
+      use rrlw_vsn, only: hvrcld, hnamcld
+
+      implicit none
+
+      contains
+
+! ------------------------------------------------------------------------------
+      subroutine cldprop(nlayers, inflag, iceflag, liqflag, cldfrac, tauc, &
+                         ciwp, clwp, rei, rel, ncbands, taucloud)
+! ------------------------------------------------------------------------------
+
+! Purpose:  Compute the cloud optical depth(s) for each cloudy layer.
+
+! ------- Input -------
+
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: inflag          ! see definitions
+      integer(kind=im), intent(in) :: iceflag         ! see definitions
+      integer(kind=im), intent(in) :: liqflag         ! see definitions
+
+      real(kind=rb), intent(in) :: cldfrac(:)         ! cloud fraction
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: ciwp(:)            ! cloud ice water path
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: clwp(:)            ! cloud liquid water path
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: rei(:)             ! cloud ice particle effective size (microns)
+                                                      !    Dimensions: (nlayers)
+                                                      ! specific definition of rei depends on setting of iceflag:
+                                                      ! iceflag = 0: ice effective radius, r_ec, (Ebert and Curry, 1992),
+                                                      !              r_ec must be >= 10.0 microns
+                                                      ! iceflag = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
+                                                      !              r_ec range is limited to 13.0 to 130.0 microns
+                                                      ! iceflag = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
+                                                      !              r_k range is limited to 5.0 to 131.0 microns
+                                                      ! iceflag = 3: generalized effective size, dge, (Fu, 1996),
+                                                      !              dge range is limited to 5.0 to 140.0 microns
+                                                      !              [dge = 1.0315 * r_ec]
+      real(kind=rb), intent(in) :: rel(:)             ! cloud liquid particle effective radius (microns)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tauc(:,:)          ! cloud optical depth
+                                                      !    Dimensions: (nbndlw,nlayers)
+
+! ------- Output -------
+
+      integer(kind=im), intent(out) :: ncbands        ! number of cloud spectral bands
+      real(kind=rb), intent(out) :: taucloud(:,:)     ! cloud optical depth
+                                                      !    Dimensions: (nlayers,nbndlw)
+
+! ------- Local -------
+
+      integer(kind=im) :: lay                         ! Layer index
+      integer(kind=im) :: ib                          ! spectral band index
+      integer(kind=im) :: index 
+      integer(kind=im) :: iceind
+      integer(kind=im) :: liqind
+      integer(kind=im) :: icb(nbndlw,0:2)
+
+      real(kind=rb) :: abscoice(nbndlw)               ! ice absorption coefficients
+      real(kind=rb) :: abscoliq(nbndlw)               ! liquid absorption coefficients
+      real(kind=rb) :: cwp                            ! cloud water path
+      real(kind=rb) :: radliq                         ! cloud liquid droplet radius (microns)
+      real(kind=rb) :: radice                         ! cloud ice effective size (microns)
+      real(kind=rb) :: factor                         ! 
+      real(kind=rb) :: fint                           ! 
+      real(kind=rb) :: tauctot(nlayers)               ! band integrated cloud optical depth
+      real(kind=rb), parameter :: eps = 1.e-6_rb      ! epsilon
+      real(kind=rb), parameter :: cldmin = 1.e-20_rb  ! minimum value for cloud quantities
+
+! ------- Definitions -------
+
+!     Explanation of the method for each value of INFLAG.  Values of
+!     0 or 1 for INFLAG do not distingish being liquid and ice clouds.
+!     INFLAG = 2 does distinguish between liquid and ice clouds, and
+!     requires further user input to specify the method to be used to 
+!     compute the aborption due to each.
+!     INFLAG = 0:  For each cloudy layer, the cloud fraction and (gray)
+!                  optical depth are input.  
+!     INFLAG = 1:  For each cloudy layer, the cloud fraction and cloud
+!                  water path (g/m2) are input.  The (gray) cloud optical 
+!                  depth is computed as in CCM2.
+!     INFLAG = 2:  For each cloudy layer, the cloud fraction, cloud 
+!                  water path (g/m2), and cloud ice fraction are input.
+!       ICEFLAG = 0:  The ice effective radius (microns) is input and the
+!                     optical depths due to ice clouds are computed as in CCM3.
+!       ICEFLAG = 1:  The ice effective radius (microns) is input and the
+!                     optical depths due to ice clouds are computed as in 
+!                     Ebert and Curry, JGR, 97, 3831-3836 (1992).  The 
+!                     spectral regions in this work have been matched with
+!                     the spectral bands in RRTM to as great an extent 
+!                     as possible:  
+!                     E&C 1      IB = 5      RRTM bands 9-16
+!                     E&C 2      IB = 4      RRTM bands 6-8
+!                     E&C 3      IB = 3      RRTM bands 3-5
+!                     E&C 4      IB = 2      RRTM band 2
+!                     E&C 5      IB = 1      RRTM band 1
+!       ICEFLAG = 2:  The ice effective radius (microns) is input and the
+!                     optical properties due to ice clouds are computed from
+!                     the optical properties stored in the RT code,
+!                     STREAMER v3.0 (Reference: Key. J., Streamer 
+!                     User's Guide, Cooperative Institute for
+!                     Meteorological Satellite Studies, 2001, 96 pp.).
+!                     Valid range of values for re are between 5.0 and
+!                     131.0 micron.
+!       ICEFLAG = 3: The ice generalized effective size (dge) is input
+!                    and the optical properties, are calculated as in
+!                    Q. Fu, J. Climate, (1998). Q. Fu provided high resolution
+!                    tables which were appropriately averaged for the
+!                    bands in RRTM_LW.  Linear interpolation is used to
+!                    get the coefficients from the stored tables.
+!                    Valid range of values for dge are between 5.0 and
+!                    140.0 micron.
+!       LIQFLAG = 0:  The optical depths due to water clouds are computed as
+!                     in CCM3.
+!       LIQFLAG = 1:  The water droplet effective radius (microns) is input 
+!                     and the optical depths due to water clouds are computed 
+!                     as in Hu and Stamnes, J., Clim., 6, 728-742, (1993).
+!                     The values for absorption coefficients appropriate for
+!                     the spectral bands in RRTM have been obtained for a 
+!                     range of effective radii by an averaging procedure 
+!                     based on the work of J. Pinto (private communication).
+!                     Linear interpolation is used to get the absorption 
+!                     coefficients for the input effective radius.
+
+      data icb /1,1,1,1,1,1,1,1,1, 1, 1, 1, 1, 1, 1, 1, &
+                1,2,3,3,3,4,4,4,5, 5, 5, 5, 5, 5, 5, 5, &
+                1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/
+
+      hvrcld = '$Revision: 1.9 $'
+
+      ncbands = 1
+      tauctot(:) = 0._rb
+
+      do lay = 1, nlayers
+         do ib = 1, nbndlw
+            taucloud(lay,ib) = 0.0_rb
+            tauctot(lay) = tauctot(lay) + tauc(ib,lay)
+         enddo
+      enddo
+
+! Main layer loop
+      do lay = 1, nlayers
+         cwp = ciwp(lay) + clwp(lay)
+         if (cldfrac(lay) .ge. cldmin .and. &
+            (cwp .ge. cldmin .or. tauctot(lay) .ge. cldmin)) then
+
+! Ice clouds and water clouds combined.
+            if (inflag .eq. 0) then
+               ncbands = 16
+               do ib = 1, ncbands
+                  taucloud(lay,ib) = tauc(ib,lay)
+               end do
+
+            elseif (inflag .eq. 1) then
+               ncbands = 16
+               do ib = 1, ncbands
+                  taucloud(lay,ib) = abscld1 * cwp
+               end do
+
+! Separate treatement of ice clouds and water clouds.
+            elseif (inflag .eq. 2) then
+               radice = rei(lay)
+
+! Calculation of absorption coefficients due to ice clouds.
+               if (ciwp(lay) .eq. 0.0_rb) then
+                  abscoice(1) = 0.0_rb
+                  iceind = 0
+
+               elseif (iceflag .eq. 0) then
+                  if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL'
+                  abscoice(1) = absice0(1) + absice0(2)/radice
+                  iceind = 0
+
+               elseif (iceflag .eq. 1) then
+                  if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop &
+                       'ICE RADIUS OUT OF BOUNDS'
+                  ncbands = 5
+                  do ib = 1, ncbands
+                     abscoice(ib) = absice1(1,ib) + absice1(2,ib)/radice
+                  enddo
+                  iceind = 1
+
+! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns
+
+               elseif (iceflag .eq. 2) then
+                  if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop 'ICE RADIUS OUT OF BOUNDS'
+                     ncbands = 16
+                     factor = (radice - 2._rb)/3._rb
+                     index = int(factor)
+                     if (index .eq. 43) index = 42
+                     fint = factor - real(index)
+                     do ib = 1, ncbands
+                        abscoice(ib) = &
+                            absice2(index,ib) + fint * &
+                            (absice2(index+1,ib) - (absice2(index,ib)))
+                     enddo
+                     iceind = 2
+
+! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns
+
+               elseif (iceflag .eq. 3) then
+                  if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) stop 'ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS'
+                     ncbands = 16
+                     factor = (radice - 2._rb)/3._rb
+                     index = int(factor)
+                     if (index .eq. 46) index = 45
+                     fint = factor - real(index)
+                     do ib = 1, ncbands
+                        abscoice(ib) = &
+                          absice3(index,ib) + fint * &
+                          (absice3(index+1,ib) - (absice3(index,ib)))
+                     enddo
+                     iceind = 2
+   
+               endif
+                  
+! Calculation of absorption coefficients due to water clouds.
+               if (clwp(lay) .eq. 0.0_rb) then
+                  abscoliq(1) = 0.0_rb
+                  liqind = 0
+                  if (iceind .eq. 1) iceind = 2
+
+               elseif (liqflag .eq. 0) then
+                  abscoliq(1) = absliq0
+                  liqind = 0
+                  if (iceind .eq. 1) iceind = 2
+
+               elseif (liqflag .eq. 1) then
+                  radliq = rel(lay)
+                  if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) stop &
+                       'LIQUID EFFECTIVE RADIUS OUT OF BOUNDS'
+                  index = int(radliq - 1.5_rb)
+                  if (index .eq. 0) index = 1
+                  if (index .eq. 58) index = 57
+                  fint = radliq - 1.5_rb - real(index)
+                  ncbands = 16
+                  do ib = 1, ncbands
+                     abscoliq(ib) = &
+                         absliq1(index,ib) + fint * &
+                         (absliq1(index+1,ib) - (absliq1(index,ib)))
+                  enddo
+                  liqind = 2
+               endif
+
+               do ib = 1, ncbands
+                  taucloud(lay,ib) = ciwp(lay) * abscoice(icb(ib,iceind)) + &
+                                     clwp(lay) * abscoliq(icb(ib,liqind))
+               enddo
+            endif
+         endif
+      enddo
+
+      end subroutine cldprop
+
+      end module rrtmg_lw_cldprop
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_init.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_init.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_init.f90	(revision 1585)
@@ -0,0 +1,2659 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_init.f90,v $
+!     author:    $Author: miacono $
+!     revision:  $Revision: 1.6 $
+!     created:   $Date: 2011/04/08 20:25:01 $
+!
+      module rrtmg_lw_init
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+      use parkind, only : im => kind_im, rb => kind_rb
+      use rrlw_wvn
+      use rrtmg_lw_setcoef, only: lwatmref, lwavplank, lwavplankderiv
+
+      implicit none
+
+      contains
+
+! **************************************************************************
+      subroutine rrtmg_lw_ini(cpdair)
+! **************************************************************************
+!
+!  Original version:       Michael J. Iacono; July, 1998
+!  First revision for GCMs:   September, 1998
+!  Second revision for RRTM_V3.0:  September, 2002
+!
+!  This subroutine performs calculations necessary for the initialization
+!  of the longwave model.  Lookup tables are computed for use in the LW
+!  radiative transfer, and input absorption coefficient data for each
+!  spectral band are reduced from 256 g-point intervals to 140.
+! **************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw
+      use rrlw_tbl, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl, tfn_tbl
+      use rrlw_vsn, only: hvrini, hnamini
+
+      real(kind=rb), intent(in) :: cpdair     ! Specific heat capacity of dry air
+                                              ! at constant pressure at 273 K
+                                              ! (J kg-1 K-1)
+
+! ------- Local -------
+
+      integer(kind=im) :: itr, ibnd, igc, ig, ind, ipr 
+      integer(kind=im) :: igcsm, iprsm
+
+      real(kind=rb) :: wtsum, wtsm(mg)        !
+      real(kind=rb) :: tfn                    !
+
+      real(kind=rb), parameter :: expeps = 1.e-20_rb   ! Smallest value for exponential table
+
+! ------- Definitions -------
+!     Arrays for 10000-point look-up tables:
+!     TAU_TBL Clear-sky optical depth (used in cloudy radiative transfer)
+!     EXP_TBL Exponential lookup table for ransmittance
+!     TFN_TBL Tau transition function; i.e. the transition of the Planck
+!             function from that for the mean layer temperature to that for
+!             the layer boundary temperature as a function of optical depth.
+!             The "linear in tau" method is used to make the table.
+!     PADE    Pade approximation constant (= 0.278)
+!     BPADE   Inverse of the Pade approximation constant
+!
+
+      hvrini = '$Revision: 1.6 $'
+
+! Initialize model data
+      call lwdatinit(cpdair)
+      call lwcmbdat               ! g-point interval reduction data
+      call lwcldpr                ! cloud optical properties
+      call lwatmref               ! reference MLS profile
+      call lwavplank              ! Planck function 
+      call lwavplankderiv         ! Planck function derivative wrt temp
+      call lw_kgb01               ! molecular absorption coefficients
+      call lw_kgb02
+      call lw_kgb03
+      call lw_kgb04
+      call lw_kgb05
+      call lw_kgb06
+      call lw_kgb07
+      call lw_kgb08
+      call lw_kgb09
+      call lw_kgb10
+      call lw_kgb11
+      call lw_kgb12
+      call lw_kgb13
+      call lw_kgb14
+      call lw_kgb15
+      call lw_kgb16
+
+! Compute lookup tables for transmittance, tau transition function,
+! and clear sky tau (for the cloudy sky radiative transfer).  Tau is 
+! computed as a function of the tau transition function, transmittance 
+! is calculated as a function of tau, and the tau transition function 
+! is calculated using the linear in tau formulation at values of tau 
+! above 0.01.  TF is approximated as tau/6 for tau < 0.01.  All tables 
+! are computed at intervals of 0.001.  The inverse of the constant used
+! in the Pade approximation to the tau transition function is set to b.
+
+      tau_tbl(0) = 0.0_rb
+      tau_tbl(ntbl) = 1.e10_rb
+      exp_tbl(0) = 1.0_rb
+      exp_tbl(ntbl) = expeps
+      tfn_tbl(0) = 0.0_rb
+      tfn_tbl(ntbl) = 1.0_rb
+      bpade = 1.0_rb / pade
+      do itr = 1, ntbl-1
+         tfn = real(itr) / real(ntbl)
+         tau_tbl(itr) = bpade * tfn / (1._rb - tfn)
+         exp_tbl(itr) = exp(-tau_tbl(itr))
+         if (exp_tbl(itr) .le. expeps) exp_tbl(itr) = expeps
+         if (tau_tbl(itr) .lt. 0.06_rb) then
+            tfn_tbl(itr) = tau_tbl(itr)/6._rb
+         else
+            tfn_tbl(itr) = 1._rb-2._rb*((1._rb/tau_tbl(itr))-(exp_tbl(itr)/(1.-exp_tbl(itr))))
+         endif
+      enddo
+
+! Perform g-point reduction from 16 per band (256 total points) to
+! a band dependant number (140 total points) for all absorption
+! coefficient input data and Planck fraction input data.
+! Compute relative weighting for new g-point combinations.
+
+      igcsm = 0
+      do ibnd = 1,nbndlw
+         iprsm = 0
+         if (ngc(ibnd).lt.mg) then
+            do igc = 1,ngc(ibnd) 
+               igcsm = igcsm + 1
+               wtsum = 0._rb
+               do ipr = 1, ngn(igcsm)
+                  iprsm = iprsm + 1
+                  wtsum = wtsum + wt(iprsm)
+               enddo
+               wtsm(igc) = wtsum
+            enddo
+            do ig = 1, ng(ibnd)
+               ind = (ibnd-1)*mg + ig
+               rwgt(ind) = wt(ig)/wtsm(ngm(ind))
+            enddo
+         else
+            do ig = 1, ng(ibnd)
+               igcsm = igcsm + 1
+               ind = (ibnd-1)*mg + ig
+               rwgt(ind) = 1.0_rb
+            enddo
+         endif
+      enddo
+
+! Reduce g-points for absorption coefficient data in each LW spectral band.
+
+      call cmbgb1
+      call cmbgb2
+      call cmbgb3
+      call cmbgb4
+      call cmbgb5
+      call cmbgb6
+      call cmbgb7
+      call cmbgb8
+      call cmbgb9
+      call cmbgb10
+      call cmbgb11
+      call cmbgb12
+      call cmbgb13
+      call cmbgb14
+      call cmbgb15
+      call cmbgb16
+
+      end subroutine rrtmg_lw_ini
+
+!***************************************************************************
+      subroutine lwdatinit(cpdair)
+!***************************************************************************
+
+! --------- Modules ----------
+
+      use parrrtm, only : maxxsec, maxinpx
+      use rrlw_con, only: heatfac, grav, planck, boltz, &
+                          clight, avogad, alosmt, gascon, radcn1, radcn2, &
+                          sbcnst, secdy 
+      use rrlw_vsn
+
+      save 
+ 
+      real(kind=rb), intent(in) :: cpdair      ! Specific heat capacity of dry air
+                                               ! at constant pressure at 273 K
+                                               ! (J kg-1 K-1)
+
+! Longwave spectral band limits (wavenumbers)
+      wavenum1(:) = (/ 10._rb, 350._rb, 500._rb, 630._rb, 700._rb, 820._rb, &
+                      980._rb,1080._rb,1180._rb,1390._rb,1480._rb,1800._rb, &
+                     2080._rb,2250._rb,2380._rb,2600._rb/)
+      wavenum2(:) = (/350._rb, 500._rb, 630._rb, 700._rb, 820._rb, 980._rb, &
+                     1080._rb,1180._rb,1390._rb,1480._rb,1800._rb,2080._rb, &
+                     2250._rb,2380._rb,2600._rb,3250._rb/)
+      delwave(:) =  (/340._rb, 150._rb, 130._rb,  70._rb, 120._rb, 160._rb, &
+                      100._rb, 100._rb, 210._rb,  90._rb, 320._rb, 280._rb, &
+                      170._rb, 130._rb, 220._rb, 650._rb/)
+
+! Spectral band information
+      ng(:) = (/16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/)
+      nspa(:) = (/1,1,9,9,9,1,9,1,9,1,1,9,9,1,9,9/)
+      nspb(:) = (/1,1,5,5,5,0,1,1,1,1,1,0,0,1,0,0/)
+
+!     nxmol     - number of cross-sections input by user
+!     ixindx(i) - index of cross-section molecule corresponding to Ith
+!                 cross-section specified by user
+!                 = 0 -- not allowed in rrtm
+!                 = 1 -- ccl4
+!                 = 2 -- cfc11
+!                 = 3 -- cfc12
+!                 = 4 -- cfc22
+      nxmol = 4
+      ixindx(1) = 1
+      ixindx(2) = 2
+      ixindx(3) = 3
+      ixindx(4) = 4
+      ixindx(5:maxinpx) = 0
+
+! Fundamental physical constants from NIST 2002
+
+      grav = 9.8066_rb                        ! Acceleration of gravity
+                                              ! (m s-2)
+      planck = 6.62606876e-27_rb              ! Planck constant
+                                              ! (ergs s; g cm2 s-1)
+      boltz = 1.3806503e-16_rb                ! Boltzmann constant
+                                              ! (ergs K-1; g cm2 s-2 K-1)
+      clight = 2.99792458e+10_rb              ! Speed of light in a vacuum  
+                                              ! (cm s-1)
+      avogad = 6.02214199e+23_rb              ! Avogadro constant
+                                              ! (mol-1)
+      alosmt = 2.6867775e+19_rb               ! Loschmidt constant
+                                              ! (cm-3)
+      gascon = 8.31447200e+07_rb              ! Molar gas constant
+                                              ! (ergs mol-1 K-1)
+      radcn1 = 1.191042722e-12_rb             ! First radiation constant
+                                              ! (W cm2 sr-1)
+      radcn2 = 1.4387752_rb                   ! Second radiation constant
+                                              ! (cm K)
+      sbcnst = 5.670400e-04_rb                ! Stefan-Boltzmann constant
+                                              ! (W cm-2 K-4)
+      secdy = 8.6400e4_rb                     ! 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_rb
+!
+!     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_rb
+!
+!     Calculated value:
+!        (grav) x (#sec/day) / (specific heat of dry air at const. p x 1.e2)
+!           Here, cpdair is in units of J kg-1 K-1, and the constant (1.e2) 
+!           converts mb to Pa when heatfac is multiplied by W m-2 mb-1. 
+      heatfac = grav * secdy / (cpdair * 1.e2_rb)
+
+      end subroutine lwdatinit
+
+!***************************************************************************
+      subroutine lwcmbdat
+!***************************************************************************
+
+      save
+ 
+! ------- Definitions -------
+!     Arrays for the g-point reduction from 256 to 140 for the 16 LW bands:
+!     This mapping from 256 to 140 points has been carefully selected to 
+!     minimize the effect on the resulting fluxes and cooling rates, and
+!     caution should be used if the mapping is modified.  The full 256
+!     g-point set can be restored with ngptlw=256, ngc=16*16, ngn=256*1., etc.
+!     ngptlw  The total number of new g-points
+!     ngc     The number of new g-points in each band
+!     ngs     The cumulative sum of new g-points for each band
+!     ngm     The index of each new g-point relative to the original
+!             16 g-points for each band.  
+!     ngn     The number of original g-points that are combined to make
+!             each new g-point in each band.
+!     ngb     The band index for each new g-point.
+!     wt      RRTM weights for 16 g-points.
+
+! ------- Data statements -------
+      ngc(:) = (/10,12,16,14,16,8,12,8,12,6,8,8,4,2,2,2/)
+      ngs(:) = (/10,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/)
+      ngm(:) = (/1,2,3,3,4,4,5,5,6,6,7,7,8,8,9,10, &          ! band 1
+                 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, &     ! band 2
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 3
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, &    ! band 4
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, &    ! band 5
+                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &           ! band 6
+                 1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, &      ! band 7
+                 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, &           ! band 8
+                 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, &     ! band 9
+                 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, &           ! band 10
+                 1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, &           ! band 11
+                 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, &           ! band 12
+                 1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, &           ! band 13
+                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &           ! band 14
+                 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, &           ! band 15
+                 1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2/)            ! band 16
+      ngn(:) = (/1,1,2,2,2,2,2,2,1,1, &                       ! band 1
+                 1,1,1,1,1,1,1,1,2,2,2,2, &                   ! band 2
+                 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 3
+                 1,1,1,1,1,1,1,1,1,1,1,1,1,3, &               ! band 4
+                 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, &           ! band 5
+                 2,2,2,2,2,2,2,2, &                           ! band 6
+                 2,2,1,1,1,1,1,1,1,1,2,2, &                   ! band 7
+                 2,2,2,2,2,2,2,2, &                           ! band 8
+                 1,1,1,1,1,1,1,1,2,2,2,2, &                   ! band 9
+                 2,2,2,2,4,4, &                               ! band 10
+                 1,1,2,2,2,2,3,3, &                           ! band 11
+                 1,1,1,1,2,2,4,4, &                           ! band 12
+                 3,3,4,6, &                                   ! band 13
+                 8,8, &                                       ! band 14
+                 8,8, &                                       ! band 15
+                 4,12/)                                       ! band 16
+      ngb(:) = (/1,1,1,1,1,1,1,1,1,1, &                       ! band 1
+                 2,2,2,2,2,2,2,2,2,2,2,2, &                   ! band 2
+                 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, &           ! band 3
+                 4,4,4,4,4,4,4,4,4,4,4,4,4,4, &               ! band 4
+                 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, &           ! band 5
+                 6,6,6,6,6,6,6,6, &                           ! band 6
+                 7,7,7,7,7,7,7,7,7,7,7,7, &                   ! band 7
+                 8,8,8,8,8,8,8,8, &                           ! band 8
+                 9,9,9,9,9,9,9,9,9,9,9,9, &                   ! band 9
+                 10,10,10,10,10,10, &                         ! band 10
+                 11,11,11,11,11,11,11,11, &                   ! band 11
+                 12,12,12,12,12,12,12,12, &                   ! band 12
+                 13,13,13,13, &                               ! band 13
+                 14,14, &                                     ! band 14
+                 15,15, &                                     ! band 15
+                 16,16/)                                      ! band 16
+      wt(:) = (/ 0.1527534276_rb, 0.1491729617_rb, 0.1420961469_rb, &
+                 0.1316886544_rb, 0.1181945205_rb, 0.1019300893_rb, &
+                 0.0832767040_rb, 0.0626720116_rb, 0.0424925000_rb, &
+                 0.0046269894_rb, 0.0038279891_rb, 0.0030260086_rb, &
+                 0.0022199750_rb, 0.0014140010_rb, 0.0005330000_rb, &
+                 0.0000750000_rb/)
+
+      end subroutine lwcmbdat
+
+!***************************************************************************
+      subroutine cmbgb1
+!***************************************************************************
+!
+!  Original version:    MJIacono; July 1998
+!  Revision for GCMs:   MJIacono; September 1998
+!  Revision for RRTMG:  MJIacono, September 2002
+!  Revision for F90 reformatting:  MJIacono, June 2006
+!
+!  The subroutines CMBGB1->CMBGB16 input the absorption coefficient
+!  data for each band, which are defined for 16 g-points and 16 spectral
+!  bands. The data are combined with appropriate weighting following the
+!  g-point mapping arrays specified in RRTMINIT.  Plank fraction data
+!  in arrays FRACREFA and FRACREFB are combined without weighting.  All
+!  g-point reduced data are put into new arrays for use in RRTM.
+!
+!  band 1:  10-350 cm-1 (low key - h2o; low minor - n2)
+!                       (high key - h2o; high minor - n2)
+!  note: previous versions of rrtm band 1: 
+!        10-250 cm-1 (low - h2o; high - h2o)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng1
+      use rrlw_kg01, only: fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, &
+                           selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mn2, kb_mn2, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumk1, sumk2, sumf1, sumf2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(1)
+               sumk = 0.
+               do ipr = 1, ngn(igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(1)
+               sumk = 0.
+               do ipr = 1, ngn(igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(1)
+            sumk = 0.
+            do ipr = 1, ngn(igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(1)
+            sumk = 0.
+            do ipr = 1, ngn(igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(1)
+            sumk1 = 0.
+            sumk2 = 0.
+            do ipr = 1, ngn(igc)
+               iprsm = iprsm + 1
+               sumk1 = sumk1 + kao_mn2(jt,iprsm)*rwgt(iprsm)
+               sumk2 = sumk2 + kbo_mn2(jt,iprsm)*rwgt(iprsm)
+            enddo
+            ka_mn2(jt,igc) = sumk1
+            kb_mn2(jt,igc) = sumk2
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(1)
+         sumf1 = 0.
+         sumf2 = 0.
+         do ipr = 1, ngn(igc)
+            iprsm = iprsm + 1
+            sumf1= sumf1+ fracrefao(iprsm)
+            sumf2= sumf2+ fracrefbo(iprsm)
+         enddo
+         fracrefa(igc) = sumf1
+         fracrefb(igc) = sumf2
+      enddo
+
+      end subroutine cmbgb1
+
+!***************************************************************************
+      subroutine cmbgb2
+!***************************************************************************
+!
+!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
+!
+!     note: previous version of rrtm band 2: 
+!           250 - 500 cm-1 (low - h2o; high - h2o)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng2
+      use rrlw_kg02, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf1, sumf2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(2)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(1)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+16)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(2)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(1)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+16)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(2)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(1)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+16)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(2)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(1)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+16)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(2)
+         sumf1 = 0.
+         sumf2 = 0.
+         do ipr = 1, ngn(ngs(1)+igc)
+            iprsm = iprsm + 1
+            sumf1= sumf1+ fracrefao(iprsm)
+            sumf2= sumf2+ fracrefbo(iprsm)
+         enddo
+         fracrefa(igc) = sumf1
+         fracrefb(igc) = sumf2
+      enddo
+
+      end subroutine cmbgb2
+
+!***************************************************************************
+      subroutine cmbgb3
+!***************************************************************************
+!
+!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
+!                           (high key - h2o,co2; high minor - n2o)
+!
+! old band 3:  500-630 cm-1 (low - h2o,co2; high - h2o,co2)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng3
+      use rrlw_kg03, only: fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, &
+                           selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mn2o, kb_mn2o, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(3)
+                 sumk = 0.
+                  do ipr = 1, ngn(ngs(2)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+32)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+      do jn = 1,5
+         do jt = 1,5
+            do jp = 13,59
+               iprsm = 0
+               do igc = 1,ngc(3)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(2)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+32)
+                  enddo
+                  kb(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,9
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(3)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(2)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+32)
+               enddo
+               ka_mn2o(jn,jt,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,5
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(3)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(2)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo_mn2o(jn,jt,iprsm)*rwgt(iprsm+32)
+               enddo
+               kb_mn2o(jn,jt,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(3)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(2)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+32)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(3)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(2)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+32)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(3)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(2)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      do jp = 1,5
+         iprsm = 0
+         do igc = 1,ngc(3)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(2)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefbo(iprsm,jp)
+            enddo
+            fracrefb(igc,jp) = sumf
+         enddo
+      enddo
+
+      end subroutine cmbgb3
+
+!***************************************************************************
+      subroutine cmbgb4
+!***************************************************************************
+!
+!     band 4:  630-700 cm-1 (low key - h2o,co2; high key - o3,co2)
+!
+! old band 4:  630-700 cm-1 (low - h2o,co2; high - o3,co2)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng4
+      use rrlw_kg04, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(4)
+                 sumk = 0.
+                  do ipr = 1, ngn(ngs(3)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+48)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+      do jn = 1,5
+         do jt = 1,5
+            do jp = 13,59
+               iprsm = 0
+               do igc = 1,ngc(4)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(3)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+48)
+                  enddo
+                  kb(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(4)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(3)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+48)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(4)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(3)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+48)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(4)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(3)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      do jp = 1,5
+         iprsm = 0
+         do igc = 1,ngc(4)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(3)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefbo(iprsm,jp)
+            enddo
+            fracrefb(igc,jp) = sumf
+         enddo
+      enddo
+
+      end subroutine cmbgb4
+
+!***************************************************************************
+      subroutine cmbgb5
+!***************************************************************************
+!
+!     band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
+!                           (high key - o3,co2)
+!
+! old band 5:  700-820 cm-1 (low - h2o,co2; high - o3,co2)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng5
+      use rrlw_kg05, only: fracrefao, fracrefbo, kao, kbo, kao_mo3, ccl4o, &
+                           selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mo3, ccl4, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(5)
+                 sumk = 0.
+                  do ipr = 1, ngn(ngs(4)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+64)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+      do jn = 1,5
+         do jt = 1,5
+            do jp = 13,59
+               iprsm = 0
+               do igc = 1,ngc(5)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(4)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kbo(jn,jt,jp,iprsm)*rwgt(iprsm+64)
+                  enddo
+                  kb(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,9
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(5)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(4)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao_mo3(jn,jt,iprsm)*rwgt(iprsm+64)
+               enddo
+               ka_mo3(jn,jt,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(5)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(4)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+64)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(5)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(4)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+64)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(5)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(4)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      do jp = 1,5
+         iprsm = 0
+         do igc = 1,ngc(5)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(4)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefbo(iprsm,jp)
+            enddo
+            fracrefb(igc,jp) = sumf
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(5)
+         sumk = 0.
+         do ipr = 1, ngn(ngs(4)+igc)
+            iprsm = iprsm + 1
+            sumk = sumk + ccl4o(iprsm)*rwgt(iprsm+64)
+         enddo
+         ccl4(igc) = sumk
+      enddo
+
+      end subroutine cmbgb5
+
+!***************************************************************************
+      subroutine cmbgb6
+!***************************************************************************
+!
+!     band 6:  820-980 cm-1 (low key - h2o; low minor - co2)
+!                           (high key - nothing; high minor - cfc11, cfc12)
+!
+! old band 6:  820-980 cm-1 (low - h2o; high - nothing)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng6
+      use rrlw_kg06, only: fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, &
+                           selfrefo, forrefo, &
+                           fracrefa, absa, ka, ka_mco2, cfc11adj, cfc12, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf, sumk1, sumk2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(6)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(5)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+80)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(6)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(5)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + kao_mco2(jt,iprsm)*rwgt(iprsm+80)
+            enddo
+            ka_mco2(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(6)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(5)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+80)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(6)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(5)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+80)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(6)
+         sumf = 0.
+         sumk1= 0.
+         sumk2= 0.
+         do ipr = 1, ngn(ngs(5)+igc)
+            iprsm = iprsm + 1
+            sumf = sumf + fracrefao(iprsm)
+            sumk1= sumk1+ cfc11adjo(iprsm)*rwgt(iprsm+80)
+            sumk2= sumk2+ cfc12o(iprsm)*rwgt(iprsm+80)
+         enddo
+         fracrefa(igc) = sumf
+         cfc11adj(igc) = sumk1
+         cfc12(igc) = sumk2
+      enddo
+
+      end subroutine cmbgb6
+
+!***************************************************************************
+      subroutine cmbgb7
+!***************************************************************************
+!
+!     band 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
+!                            (high key - o3; high minor - co2)
+!
+! old band 7:  980-1080 cm-1 (low - h2o,o3; high - o3)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng7
+      use rrlw_kg07, only: fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, &
+                           selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, ka_mco2, kb_mco2, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(7)
+                 sumk = 0.
+                  do ipr = 1, ngn(ngs(6)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+96)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(7)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(6)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+96)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,9
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(7)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(6)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+96)
+               enddo
+               ka_mco2(jn,jt,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(7)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(6)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + kbo_mco2(jt,iprsm)*rwgt(iprsm+96)
+            enddo
+            kb_mco2(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(7)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(6)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+96)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(7)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(6)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+96)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(7)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(6)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(7)
+         sumf = 0.
+         do ipr = 1, ngn(ngs(6)+igc)
+            iprsm = iprsm + 1
+            sumf = sumf + fracrefbo(iprsm)
+         enddo
+         fracrefb(igc) = sumf
+      enddo
+
+      end subroutine cmbgb7
+
+!***************************************************************************
+      subroutine cmbgb8
+!***************************************************************************
+!
+!     band 8:  1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
+!                             (high key - o3; high minor - co2, n2o)
+!
+! old band 8:  1080-1180 cm-1 (low (i.e.>~300mb) - h2o; high - o3)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng8
+      use rrlw_kg08, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, &
+                           kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, &
+                           cfc12o, cfc22adjo, &
+                           fracrefa, fracrefb, absa, ka, ka_mco2, ka_mn2o, &
+                           ka_mo3, absb, kb, kb_mco2, kb_mn2o, selfref, forref, &
+                           cfc12, cfc22adj
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumk1, sumk2, sumk3, sumk4, sumk5, sumf1, sumf2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(8)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(7)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+112)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(8)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(7)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+112)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(8)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(7)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+112)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(8)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(7)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+112)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(8)
+            sumk1 = 0.
+            sumk2 = 0.
+            sumk3 = 0.
+            sumk4 = 0.
+            sumk5 = 0.
+            do ipr = 1, ngn(ngs(7)+igc)
+               iprsm = iprsm + 1
+               sumk1 = sumk1 + kao_mco2(jt,iprsm)*rwgt(iprsm+112)
+               sumk2 = sumk2 + kbo_mco2(jt,iprsm)*rwgt(iprsm+112)
+               sumk3 = sumk3 + kao_mo3(jt,iprsm)*rwgt(iprsm+112)
+               sumk4 = sumk4 + kao_mn2o(jt,iprsm)*rwgt(iprsm+112)
+               sumk5 = sumk5 + kbo_mn2o(jt,iprsm)*rwgt(iprsm+112)
+            enddo
+            ka_mco2(jt,igc) = sumk1
+            kb_mco2(jt,igc) = sumk2
+            ka_mo3(jt,igc) = sumk3
+            ka_mn2o(jt,igc) = sumk4
+            kb_mn2o(jt,igc) = sumk5
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(8)
+         sumf1= 0.
+         sumf2= 0.
+         sumk1= 0.
+         sumk2= 0.
+         do ipr = 1, ngn(ngs(7)+igc)
+            iprsm = iprsm + 1
+            sumf1= sumf1+ fracrefao(iprsm)
+            sumf2= sumf2+ fracrefbo(iprsm)
+            sumk1= sumk1+ cfc12o(iprsm)*rwgt(iprsm+112)
+            sumk2= sumk2+ cfc22adjo(iprsm)*rwgt(iprsm+112)
+         enddo
+         fracrefa(igc) = sumf1
+         fracrefb(igc) = sumf2
+         cfc12(igc) = sumk1
+         cfc22adj(igc) = sumk2
+      enddo
+
+      end subroutine cmbgb8
+
+!***************************************************************************
+      subroutine cmbgb9
+!***************************************************************************
+!
+!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
+!                             (high key - ch4; high minor - n2o)!
+
+! old band 9:  1180-1390 cm-1 (low - h2o,ch4; high - ch4)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng9
+      use rrlw_kg09, only: fracrefao, fracrefbo, kao, kao_mn2o, &
+                           kbo, kbo_mn2o, selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, ka_mn2o, &
+                           absb, kb, kb_mn2o, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(9)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(8)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+128)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(9)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(8)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+128)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,9
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(9)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(8)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao_mn2o(jn,jt,iprsm)*rwgt(iprsm+128)
+               enddo
+               ka_mn2o(jn,jt,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(9)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(8)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + kbo_mn2o(jt,iprsm)*rwgt(iprsm+128)
+            enddo
+            kb_mn2o(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(9)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(8)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+128)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(9)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(8)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+128)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(9)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(8)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(9)
+         sumf = 0.
+         do ipr = 1, ngn(ngs(8)+igc)
+            iprsm = iprsm + 1
+            sumf = sumf + fracrefbo(iprsm)
+         enddo
+         fracrefb(igc) = sumf
+      enddo
+
+      end subroutine cmbgb9
+
+!***************************************************************************
+      subroutine cmbgb10
+!***************************************************************************
+!
+!     band 10:  1390-1480 cm-1 (low key - h2o; high key - h2o)
+!
+! old band 10:  1390-1480 cm-1 (low - h2o; high - h2o)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng10
+      use rrlw_kg10, only: fracrefao, fracrefbo, kao, kbo, &
+                           selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf1, sumf2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(10)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(9)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+144)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(10)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(9)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+144)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(10)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(9)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+144)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(10)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(9)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+144)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(10)
+         sumf1= 0.
+         sumf2= 0.
+         do ipr = 1, ngn(ngs(9)+igc)
+            iprsm = iprsm + 1
+            sumf1= sumf1+ fracrefao(iprsm)
+            sumf2= sumf2+ fracrefbo(iprsm)
+         enddo
+         fracrefa(igc) = sumf1
+         fracrefb(igc) = sumf2
+      enddo
+
+      end subroutine cmbgb10
+
+!***************************************************************************
+      subroutine cmbgb11
+!***************************************************************************
+!
+!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
+!                              (high key - h2o; high minor - o2)
+!
+! old band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
+!                              (high key - h2o; high minor - o2)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng11
+      use rrlw_kg11, only: fracrefao, fracrefbo, kao, kao_mo2, &
+                           kbo, kbo_mo2, selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, ka_mo2, &
+                           absb, kb, kb_mo2, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumk1, sumk2, sumf1, sumf2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(11)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(10)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+160)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(11)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(10)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+160)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(11)
+            sumk1 = 0.
+            sumk2 = 0.
+            do ipr = 1, ngn(ngs(10)+igc)
+               iprsm = iprsm + 1
+               sumk1 = sumk1 + kao_mo2(jt,iprsm)*rwgt(iprsm+160)
+               sumk2 = sumk2 + kbo_mo2(jt,iprsm)*rwgt(iprsm+160)
+            enddo
+            ka_mo2(jt,igc) = sumk1
+            kb_mo2(jt,igc) = sumk2
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(11)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(10)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+160)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(11)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(10)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+160)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(11)
+         sumf1= 0.
+         sumf2= 0.
+         do ipr = 1, ngn(ngs(10)+igc)
+            iprsm = iprsm + 1
+            sumf1= sumf1+ fracrefao(iprsm)
+            sumf2= sumf2+ fracrefbo(iprsm)
+         enddo
+         fracrefa(igc) = sumf1
+         fracrefb(igc) = sumf2
+      enddo
+
+      end subroutine cmbgb11
+
+!***************************************************************************
+      subroutine cmbgb12
+!***************************************************************************
+!
+!     band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
+!
+! old band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng12
+      use rrlw_kg12, only: fracrefao, kao, selfrefo, forrefo, &
+                           fracrefa, absa, ka, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(12)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(11)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+176)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(12)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(11)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+176)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(12)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(11)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+176)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(12)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(11)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      end subroutine cmbgb12
+
+!***************************************************************************
+      subroutine cmbgb13
+!***************************************************************************
+!
+!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
+!
+! old band 13:  2080-2250 cm-1 (low - h2o,n2o; high - nothing)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng13
+      use rrlw_kg13, only: fracrefao, fracrefbo, kao, kao_mco2, kao_mco, &
+                           kbo_mo3, selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, ka_mco2, ka_mco, &
+                           kb_mo3, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumk1, sumk2, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(13)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(12)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+192)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,9
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(13)
+              sumk1 = 0.
+              sumk2 = 0.
+               do ipr = 1, ngn(ngs(12)+igc)
+                  iprsm = iprsm + 1
+                  sumk1 = sumk1 + kao_mco2(jn,jt,iprsm)*rwgt(iprsm+192)
+                  sumk2 = sumk2 + kao_mco(jn,jt,iprsm)*rwgt(iprsm+192)
+               enddo
+               ka_mco2(jn,jt,igc) = sumk1
+               ka_mco(jn,jt,igc) = sumk2
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,19
+         iprsm = 0
+         do igc = 1,ngc(13)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(12)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + kbo_mo3(jt,iprsm)*rwgt(iprsm+192)
+            enddo
+            kb_mo3(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(13)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(12)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+192)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(13)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(12)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+192)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(13)
+         sumf = 0.
+         do ipr = 1, ngn(ngs(12)+igc)
+            iprsm = iprsm + 1
+            sumf = sumf + fracrefbo(iprsm)
+         enddo
+         fracrefb(igc) = sumf
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(13)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(12)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      end subroutine cmbgb13
+
+!***************************************************************************
+      subroutine cmbgb14
+!***************************************************************************
+!
+!     band 14:  2250-2380 cm-1 (low - co2; high - co2)
+!
+! old band 14:  2250-2380 cm-1 (low - co2; high - co2)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng14
+      use rrlw_kg14, only: fracrefao, fracrefbo, kao, kbo, &
+                           selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, &
+                           selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf1, sumf2
+
+
+      do jt = 1,5
+         do jp = 1,13
+            iprsm = 0
+            do igc = 1,ngc(14)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(13)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao(jt,jp,iprsm)*rwgt(iprsm+208)
+               enddo
+               ka(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(14)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(13)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+208)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(14)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(13)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+208)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(14)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(13)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+208)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(14)
+         sumf1= 0.
+         sumf2= 0.
+         do ipr = 1, ngn(ngs(13)+igc)
+            iprsm = iprsm + 1
+            sumf1= sumf1+ fracrefao(iprsm)
+            sumf2= sumf2+ fracrefbo(iprsm)
+         enddo
+         fracrefa(igc) = sumf1
+         fracrefb(igc) = sumf2
+      enddo
+
+      end subroutine cmbgb14
+
+!***************************************************************************
+      subroutine cmbgb15
+!***************************************************************************
+!
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+!
+! old band 15:  2380-2600 cm-1 (low - n2o,co2; high - nothing)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng15
+      use rrlw_kg15, only: fracrefao, kao, kao_mn2, selfrefo, forrefo, &
+                           fracrefa, absa, ka, ka_mn2, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(15)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(14)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+224)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jn = 1,9
+         do jt = 1,19
+            iprsm = 0
+            do igc = 1,ngc(15)
+              sumk = 0.
+               do ipr = 1, ngn(ngs(14)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kao_mn2(jn,jt,iprsm)*rwgt(iprsm+224)
+               enddo
+               ka_mn2(jn,jt,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(15)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(14)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+224)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(15)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(14)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+224)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(15)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(14)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      end subroutine cmbgb15
+
+!***************************************************************************
+      subroutine cmbgb16
+!***************************************************************************
+!
+!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
+!
+! old band 16:  2600-3000 cm-1 (low - h2o,ch4; high - nothing)
+!***************************************************************************
+
+      use parrrtm, only : mg, nbndlw, ngptlw, ng16
+      use rrlw_kg16, only: fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, &
+                           fracrefa, fracrefb, absa, ka, absb, kb, selfref, forref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm 
+      real(kind=rb) :: sumk, sumf
+
+
+      do jn = 1,9
+         do jt = 1,5
+            do jp = 1,13
+               iprsm = 0
+               do igc = 1,ngc(16)
+                  sumk = 0.
+                  do ipr = 1, ngn(ngs(15)+igc)
+                     iprsm = iprsm + 1
+                     sumk = sumk + kao(jn,jt,jp,iprsm)*rwgt(iprsm+240)
+                  enddo
+                  ka(jn,jt,jp,igc) = sumk
+               enddo
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,5
+         do jp = 13,59
+            iprsm = 0
+            do igc = 1,ngc(16)
+               sumk = 0.
+               do ipr = 1, ngn(ngs(15)+igc)
+                  iprsm = iprsm + 1
+                  sumk = sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+240)
+               enddo
+               kb(jt,jp,igc) = sumk
+            enddo
+         enddo
+      enddo
+
+      do jt = 1,10
+         iprsm = 0
+         do igc = 1,ngc(16)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(15)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + selfrefo(jt,iprsm)*rwgt(iprsm+240)
+            enddo
+            selfref(jt,igc) = sumk
+         enddo
+      enddo
+
+      do jt = 1,4
+         iprsm = 0
+         do igc = 1,ngc(16)
+            sumk = 0.
+            do ipr = 1, ngn(ngs(15)+igc)
+               iprsm = iprsm + 1
+               sumk = sumk + forrefo(jt,iprsm)*rwgt(iprsm+240)
+            enddo
+            forref(jt,igc) = sumk
+         enddo
+      enddo
+
+      iprsm = 0
+      do igc = 1,ngc(16)
+         sumf = 0.
+         do ipr = 1, ngn(ngs(15)+igc)
+            iprsm = iprsm + 1
+            sumf = sumf + fracrefbo(iprsm)
+         enddo
+         fracrefb(igc) = sumf
+      enddo
+
+      do jp = 1,9
+         iprsm = 0
+         do igc = 1,ngc(16)
+            sumf = 0.
+            do ipr = 1, ngn(ngs(15)+igc)
+               iprsm = iprsm + 1
+               sumf = sumf + fracrefao(iprsm,jp)
+            enddo
+            fracrefa(igc,jp) = sumf
+         enddo
+      enddo
+
+      end subroutine cmbgb16
+
+!***************************************************************************
+      subroutine lwcldpr
+!***************************************************************************
+
+! --------- Modules ----------
+
+      use rrlw_cld, only: abscld1, absliq0, absliq1, &
+                          absice0, absice1, absice2, absice3
+
+      save
+
+! ABSCLDn is the liquid water absorption coefficient (m2/g). 
+! For INFLAG = 1.
+      abscld1 = 0.0602410_rb
+!  
+! Everything below is for INFLAG = 2.
+
+! ABSICEn(J,IB) are the parameters needed to compute the liquid water 
+! absorption coefficient in spectral region IB for ICEFLAG=n.  The units
+! of ABSICEn(1,IB) are m2/g and ABSICEn(2,IB) has units (microns (m2/g)).
+! For ICEFLAG = 0.
+
+      absice0(:)= (/0.005_rb,  1.0_rb/)
+
+! For ICEFLAG = 1.
+      absice1(1,:) = (/0.0036_rb, 0.0068_rb, 0.0003_rb, 0.0016_rb, 0.0020_rb/)
+      absice1(2,:) = (/1.136_rb , 0.600_rb , 1.338_rb , 1.166_rb , 1.118_rb /)
+
+! For ICEFLAG = 2.  In each band, the absorption
+! coefficients are listed for a range of effective radii from 5.0
+! to 131.0 microns in increments of 3.0 microns.
+! Spherical Ice Particle Parameterization
+! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)]
+      absice2(:,1) = (/ &
+! band 1
+       7.798999e-02_rb,6.340479e-02_rb,5.417973e-02_rb,4.766245e-02_rb,4.272663e-02_rb, &
+       3.880939e-02_rb,3.559544e-02_rb,3.289241e-02_rb,3.057511e-02_rb,2.855800e-02_rb, &
+       2.678022e-02_rb,2.519712e-02_rb,2.377505e-02_rb,2.248806e-02_rb,2.131578e-02_rb, &
+       2.024194e-02_rb,1.925337e-02_rb,1.833926e-02_rb,1.749067e-02_rb,1.670007e-02_rb, &
+       1.596113e-02_rb,1.526845e-02_rb,1.461739e-02_rb,1.400394e-02_rb,1.342462e-02_rb, &
+       1.287639e-02_rb,1.235656e-02_rb,1.186279e-02_rb,1.139297e-02_rb,1.094524e-02_rb, &
+       1.051794e-02_rb,1.010956e-02_rb,9.718755e-03_rb,9.344316e-03_rb,8.985139e-03_rb, &
+       8.640223e-03_rb,8.308656e-03_rb,7.989606e-03_rb,7.682312e-03_rb,7.386076e-03_rb, &
+       7.100255e-03_rb,6.824258e-03_rb,6.557540e-03_rb/)
+      absice2(:,2) = (/ &
+! band 2
+       2.784879e-02_rb,2.709863e-02_rb,2.619165e-02_rb,2.529230e-02_rb,2.443225e-02_rb, &
+       2.361575e-02_rb,2.284021e-02_rb,2.210150e-02_rb,2.139548e-02_rb,2.071840e-02_rb, &
+       2.006702e-02_rb,1.943856e-02_rb,1.883064e-02_rb,1.824120e-02_rb,1.766849e-02_rb, &
+       1.711099e-02_rb,1.656737e-02_rb,1.603647e-02_rb,1.551727e-02_rb,1.500886e-02_rb, &
+       1.451045e-02_rb,1.402132e-02_rb,1.354084e-02_rb,1.306842e-02_rb,1.260355e-02_rb, &
+       1.214575e-02_rb,1.169460e-02_rb,1.124971e-02_rb,1.081072e-02_rb,1.037731e-02_rb, &
+       9.949167e-03_rb,9.526021e-03_rb,9.107615e-03_rb,8.693714e-03_rb,8.284096e-03_rb, &
+       7.878558e-03_rb,7.476910e-03_rb,7.078974e-03_rb,6.684586e-03_rb,6.293589e-03_rb, &
+       5.905839e-03_rb,5.521200e-03_rb,5.139543e-03_rb/)
+      absice2(:,3) = (/ &
+! band 3
+       1.065397e-01_rb,8.005726e-02_rb,6.546428e-02_rb,5.589131e-02_rb,4.898681e-02_rb, &
+       4.369932e-02_rb,3.947901e-02_rb,3.600676e-02_rb,3.308299e-02_rb,3.057561e-02_rb, &
+       2.839325e-02_rb,2.647040e-02_rb,2.475872e-02_rb,2.322164e-02_rb,2.183091e-02_rb, &
+       2.056430e-02_rb,1.940407e-02_rb,1.833586e-02_rb,1.734787e-02_rb,1.643034e-02_rb, &
+       1.557512e-02_rb,1.477530e-02_rb,1.402501e-02_rb,1.331924e-02_rb,1.265364e-02_rb, &
+       1.202445e-02_rb,1.142838e-02_rb,1.086257e-02_rb,1.032445e-02_rb,9.811791e-03_rb, &
+       9.322587e-03_rb,8.855053e-03_rb,8.407591e-03_rb,7.978763e-03_rb,7.567273e-03_rb, &
+       7.171949e-03_rb,6.791728e-03_rb,6.425642e-03_rb,6.072809e-03_rb,5.732424e-03_rb, &
+       5.403748e-03_rb,5.086103e-03_rb,4.778865e-03_rb/)
+      absice2(:,4) = (/ &
+! band 4
+       1.804566e-01_rb,1.168987e-01_rb,8.680442e-02_rb,6.910060e-02_rb,5.738174e-02_rb, &
+       4.902332e-02_rb,4.274585e-02_rb,3.784923e-02_rb,3.391734e-02_rb,3.068690e-02_rb, &
+       2.798301e-02_rb,2.568480e-02_rb,2.370600e-02_rb,2.198337e-02_rb,2.046940e-02_rb, &
+       1.912777e-02_rb,1.793016e-02_rb,1.685420e-02_rb,1.588193e-02_rb,1.499882e-02_rb, &
+       1.419293e-02_rb,1.345440e-02_rb,1.277496e-02_rb,1.214769e-02_rb,1.156669e-02_rb, &
+       1.102694e-02_rb,1.052412e-02_rb,1.005451e-02_rb,9.614854e-03_rb,9.202335e-03_rb, &
+       8.814470e-03_rb,8.449077e-03_rb,8.104223e-03_rb,7.778195e-03_rb,7.469466e-03_rb, &
+       7.176671e-03_rb,6.898588e-03_rb,6.634117e-03_rb,6.382264e-03_rb,6.142134e-03_rb, &
+       5.912913e-03_rb,5.693862e-03_rb,5.484308e-03_rb/)
+      absice2(:,5) = (/ &
+! band 5
+       2.131806e-01_rb,1.311372e-01_rb,9.407171e-02_rb,7.299442e-02_rb,5.941273e-02_rb, &
+       4.994043e-02_rb,4.296242e-02_rb,3.761113e-02_rb,3.337910e-02_rb,2.994978e-02_rb, &
+       2.711556e-02_rb,2.473461e-02_rb,2.270681e-02_rb,2.095943e-02_rb,1.943839e-02_rb, &
+       1.810267e-02_rb,1.692057e-02_rb,1.586719e-02_rb,1.492275e-02_rb,1.407132e-02_rb, &
+       1.329989e-02_rb,1.259780e-02_rb,1.195618e-02_rb,1.136761e-02_rb,1.082583e-02_rb, &
+       1.032552e-02_rb,9.862158e-03_rb,9.431827e-03_rb,9.031157e-03_rb,8.657217e-03_rb, &
+       8.307449e-03_rb,7.979609e-03_rb,7.671724e-03_rb,7.382048e-03_rb,7.109032e-03_rb, &
+       6.851298e-03_rb,6.607615e-03_rb,6.376881e-03_rb,6.158105e-03_rb,5.950394e-03_rb, &
+       5.752942e-03_rb,5.565019e-03_rb,5.385963e-03_rb/)
+      absice2(:,6) = (/ &
+! band 6
+       1.546177e-01_rb,1.039251e-01_rb,7.910347e-02_rb,6.412429e-02_rb,5.399997e-02_rb, &
+       4.664937e-02_rb,4.104237e-02_rb,3.660781e-02_rb,3.300218e-02_rb,3.000586e-02_rb, &
+       2.747148e-02_rb,2.529633e-02_rb,2.340647e-02_rb,2.174723e-02_rb,2.027731e-02_rb, &
+       1.896487e-02_rb,1.778492e-02_rb,1.671761e-02_rb,1.574692e-02_rb,1.485978e-02_rb, &
+       1.404543e-02_rb,1.329489e-02_rb,1.260066e-02_rb,1.195636e-02_rb,1.135657e-02_rb, &
+       1.079664e-02_rb,1.027257e-02_rb,9.780871e-03_rb,9.318505e-03_rb,8.882815e-03_rb, &
+       8.471458e-03_rb,8.082364e-03_rb,7.713696e-03_rb,7.363817e-03_rb,7.031264e-03_rb, &
+       6.714725e-03_rb,6.413021e-03_rb,6.125086e-03_rb,5.849958e-03_rb,5.586764e-03_rb, &
+       5.334707e-03_rb,5.093066e-03_rb,4.861179e-03_rb/)
+      absice2(:,7) = (/ &
+! band 7
+       7.583404e-02_rb,6.181558e-02_rb,5.312027e-02_rb,4.696039e-02_rb,4.225986e-02_rb, &
+       3.849735e-02_rb,3.538340e-02_rb,3.274182e-02_rb,3.045798e-02_rb,2.845343e-02_rb, &
+       2.667231e-02_rb,2.507353e-02_rb,2.362606e-02_rb,2.230595e-02_rb,2.109435e-02_rb, &
+       1.997617e-02_rb,1.893916e-02_rb,1.797328e-02_rb,1.707016e-02_rb,1.622279e-02_rb, &
+       1.542523e-02_rb,1.467241e-02_rb,1.395997e-02_rb,1.328414e-02_rb,1.264164e-02_rb, &
+       1.202958e-02_rb,1.144544e-02_rb,1.088697e-02_rb,1.035218e-02_rb,9.839297e-03_rb, &
+       9.346733e-03_rb,8.873057e-03_rb,8.416980e-03_rb,7.977335e-03_rb,7.553066e-03_rb, &
+       7.143210e-03_rb,6.746888e-03_rb,6.363297e-03_rb,5.991700e-03_rb,5.631422e-03_rb, &
+       5.281840e-03_rb,4.942378e-03_rb,4.612505e-03_rb/)
+      absice2(:,8) = (/ &
+! band 8
+       9.022185e-02_rb,6.922700e-02_rb,5.710674e-02_rb,4.898377e-02_rb,4.305946e-02_rb, &
+       3.849553e-02_rb,3.484183e-02_rb,3.183220e-02_rb,2.929794e-02_rb,2.712627e-02_rb, &
+       2.523856e-02_rb,2.357810e-02_rb,2.210286e-02_rb,2.078089e-02_rb,1.958747e-02_rb, &
+       1.850310e-02_rb,1.751218e-02_rb,1.660205e-02_rb,1.576232e-02_rb,1.498440e-02_rb, &
+       1.426107e-02_rb,1.358624e-02_rb,1.295474e-02_rb,1.236212e-02_rb,1.180456e-02_rb, &
+       1.127874e-02_rb,1.078175e-02_rb,1.031106e-02_rb,9.864433e-03_rb,9.439878e-03_rb, &
+       9.035637e-03_rb,8.650140e-03_rb,8.281981e-03_rb,7.929895e-03_rb,7.592746e-03_rb, &
+       7.269505e-03_rb,6.959238e-03_rb,6.661100e-03_rb,6.374317e-03_rb,6.098185e-03_rb, &
+       5.832059e-03_rb,5.575347e-03_rb,5.327504e-03_rb/)
+      absice2(:,9) = (/ &
+! band 9
+       1.294087e-01_rb,8.788217e-02_rb,6.728288e-02_rb,5.479720e-02_rb,4.635049e-02_rb, &
+       4.022253e-02_rb,3.555576e-02_rb,3.187259e-02_rb,2.888498e-02_rb,2.640843e-02_rb, &
+       2.431904e-02_rb,2.253038e-02_rb,2.098024e-02_rb,1.962267e-02_rb,1.842293e-02_rb, &
+       1.735426e-02_rb,1.639571e-02_rb,1.553060e-02_rb,1.474552e-02_rb,1.402953e-02_rb, &
+       1.337363e-02_rb,1.277033e-02_rb,1.221336e-02_rb,1.169741e-02_rb,1.121797e-02_rb, &
+       1.077117e-02_rb,1.035369e-02_rb,9.962643e-03_rb,9.595509e-03_rb,9.250088e-03_rb, &
+       8.924447e-03_rb,8.616876e-03_rb,8.325862e-03_rb,8.050057e-03_rb,7.788258e-03_rb, &
+       7.539388e-03_rb,7.302478e-03_rb,7.076656e-03_rb,6.861134e-03_rb,6.655197e-03_rb, &
+       6.458197e-03_rb,6.269543e-03_rb,6.088697e-03_rb/)
+      absice2(:,10) = (/ &
+! band 10
+       1.593628e-01_rb,1.014552e-01_rb,7.458955e-02_rb,5.903571e-02_rb,4.887582e-02_rb, &
+       4.171159e-02_rb,3.638480e-02_rb,3.226692e-02_rb,2.898717e-02_rb,2.631256e-02_rb, &
+       2.408925e-02_rb,2.221156e-02_rb,2.060448e-02_rb,1.921325e-02_rb,1.799699e-02_rb, &
+       1.692456e-02_rb,1.597177e-02_rb,1.511961e-02_rb,1.435289e-02_rb,1.365933e-02_rb, &
+       1.302890e-02_rb,1.245334e-02_rb,1.192576e-02_rb,1.144037e-02_rb,1.099230e-02_rb, &
+       1.057739e-02_rb,1.019208e-02_rb,9.833302e-03_rb,9.498395e-03_rb,9.185047e-03_rb, &
+       8.891237e-03_rb,8.615185e-03_rb,8.355325e-03_rb,8.110267e-03_rb,7.878778e-03_rb, &
+       7.659759e-03_rb,7.452224e-03_rb,7.255291e-03_rb,7.068166e-03_rb,6.890130e-03_rb, &
+       6.720536e-03_rb,6.558794e-03_rb,6.404371e-03_rb/)
+      absice2(:,11) = (/ &
+! band 11
+       1.656227e-01_rb,1.032129e-01_rb,7.487359e-02_rb,5.871431e-02_rb,4.828355e-02_rb, &
+       4.099989e-02_rb,3.562924e-02_rb,3.150755e-02_rb,2.824593e-02_rb,2.560156e-02_rb, &
+       2.341503e-02_rb,2.157740e-02_rb,2.001169e-02_rb,1.866199e-02_rb,1.748669e-02_rb, &
+       1.645421e-02_rb,1.554015e-02_rb,1.472535e-02_rb,1.399457e-02_rb,1.333553e-02_rb, &
+       1.273821e-02_rb,1.219440e-02_rb,1.169725e-02_rb,1.124104e-02_rb,1.082096e-02_rb, &
+       1.043290e-02_rb,1.007336e-02_rb,9.739338e-03_rb,9.428223e-03_rb,9.137756e-03_rb, &
+       8.865964e-03_rb,8.611115e-03_rb,8.371686e-03_rb,8.146330e-03_rb,7.933852e-03_rb, &
+       7.733187e-03_rb,7.543386e-03_rb,7.363597e-03_rb,7.193056e-03_rb,7.031072e-03_rb, &
+       6.877024e-03_rb,6.730348e-03_rb,6.590531e-03_rb/)
+      absice2(:,12) = (/ &
+! band 12
+       9.194591e-02_rb,6.446867e-02_rb,4.962034e-02_rb,4.042061e-02_rb,3.418456e-02_rb, &
+       2.968856e-02_rb,2.629900e-02_rb,2.365572e-02_rb,2.153915e-02_rb,1.980791e-02_rb, &
+       1.836689e-02_rb,1.714979e-02_rb,1.610900e-02_rb,1.520946e-02_rb,1.442476e-02_rb, &
+       1.373468e-02_rb,1.312345e-02_rb,1.257858e-02_rb,1.209010e-02_rb,1.164990e-02_rb, &
+       1.125136e-02_rb,1.088901e-02_rb,1.055827e-02_rb,1.025531e-02_rb,9.976896e-03_rb, &
+       9.720255e-03_rb,9.483022e-03_rb,9.263160e-03_rb,9.058902e-03_rb,8.868710e-03_rb, &
+       8.691240e-03_rb,8.525312e-03_rb,8.369886e-03_rb,8.224042e-03_rb,8.086961e-03_rb, &
+       7.957917e-03_rb,7.836258e-03_rb,7.721400e-03_rb,7.612821e-03_rb,7.510045e-03_rb, &
+       7.412648e-03_rb,7.320242e-03_rb,7.232476e-03_rb/)
+      absice2(:,13) = (/ &
+! band 13
+       1.437021e-01_rb,8.872535e-02_rb,6.392420e-02_rb,4.991833e-02_rb,4.096790e-02_rb, &
+       3.477881e-02_rb,3.025782e-02_rb,2.681909e-02_rb,2.412102e-02_rb,2.195132e-02_rb, &
+       2.017124e-02_rb,1.868641e-02_rb,1.743044e-02_rb,1.635529e-02_rb,1.542540e-02_rb, &
+       1.461388e-02_rb,1.390003e-02_rb,1.326766e-02_rb,1.270395e-02_rb,1.219860e-02_rb, &
+       1.174326e-02_rb,1.133107e-02_rb,1.095637e-02_rb,1.061442e-02_rb,1.030126e-02_rb, &
+       1.001352e-02_rb,9.748340e-03_rb,9.503256e-03_rb,9.276155e-03_rb,9.065205e-03_rb, &
+       8.868808e-03_rb,8.685571e-03_rb,8.514268e-03_rb,8.353820e-03_rb,8.203272e-03_rb, &
+       8.061776e-03_rb,7.928578e-03_rb,7.803001e-03_rb,7.684443e-03_rb,7.572358e-03_rb, &
+       7.466258e-03_rb,7.365701e-03_rb,7.270286e-03_rb/)
+      absice2(:,14) = (/ &
+! band 14
+       1.288870e-01_rb,8.160295e-02_rb,5.964745e-02_rb,4.703790e-02_rb,3.888637e-02_rb, &
+       3.320115e-02_rb,2.902017e-02_rb,2.582259e-02_rb,2.330224e-02_rb,2.126754e-02_rb, &
+       1.959258e-02_rb,1.819130e-02_rb,1.700289e-02_rb,1.598320e-02_rb,1.509942e-02_rb, &
+       1.432666e-02_rb,1.364572e-02_rb,1.304156e-02_rb,1.250220e-02_rb,1.201803e-02_rb, &
+       1.158123e-02_rb,1.118537e-02_rb,1.082513e-02_rb,1.049605e-02_rb,1.019440e-02_rb, &
+       9.916989e-03_rb,9.661116e-03_rb,9.424457e-03_rb,9.205005e-03_rb,9.001022e-03_rb, &
+       8.810992e-03_rb,8.633588e-03_rb,8.467646e-03_rb,8.312137e-03_rb,8.166151e-03_rb, &
+       8.028878e-03_rb,7.899597e-03_rb,7.777663e-03_rb,7.662498e-03_rb,7.553581e-03_rb, &
+       7.450444e-03_rb,7.352662e-03_rb,7.259851e-03_rb/)
+      absice2(:,15) = (/ &
+! band 15
+       8.254229e-02_rb,5.808787e-02_rb,4.492166e-02_rb,3.675028e-02_rb,3.119623e-02_rb, &
+       2.718045e-02_rb,2.414450e-02_rb,2.177073e-02_rb,1.986526e-02_rb,1.830306e-02_rb, &
+       1.699991e-02_rb,1.589698e-02_rb,1.495199e-02_rb,1.413374e-02_rb,1.341870e-02_rb, &
+       1.278883e-02_rb,1.223002e-02_rb,1.173114e-02_rb,1.128322e-02_rb,1.087900e-02_rb, &
+       1.051254e-02_rb,1.017890e-02_rb,9.873991e-03_rb,9.594347e-03_rb,9.337044e-03_rb, &
+       9.099589e-03_rb,8.879842e-03_rb,8.675960e-03_rb,8.486341e-03_rb,8.309594e-03_rb, &
+       8.144500e-03_rb,7.989986e-03_rb,7.845109e-03_rb,7.709031e-03_rb,7.581007e-03_rb, &
+       7.460376e-03_rb,7.346544e-03_rb,7.238978e-03_rb,7.137201e-03_rb,7.040780e-03_rb, &
+       6.949325e-03_rb,6.862483e-03_rb,6.779931e-03_rb/)
+      absice2(:,16) = (/ &
+! band 16
+       1.382062e-01_rb,8.643227e-02_rb,6.282935e-02_rb,4.934783e-02_rb,4.063891e-02_rb, &
+       3.455591e-02_rb,3.007059e-02_rb,2.662897e-02_rb,2.390631e-02_rb,2.169972e-02_rb, &
+       1.987596e-02_rb,1.834393e-02_rb,1.703924e-02_rb,1.591513e-02_rb,1.493679e-02_rb, &
+       1.407780e-02_rb,1.331775e-02_rb,1.264061e-02_rb,1.203364e-02_rb,1.148655e-02_rb, &
+       1.099099e-02_rb,1.054006e-02_rb,1.012807e-02_rb,9.750215e-03_rb,9.402477e-03_rb, &
+       9.081428e-03_rb,8.784143e-03_rb,8.508107e-03_rb,8.251146e-03_rb,8.011373e-03_rb, &
+       7.787140e-03_rb,7.577002e-03_rb,7.379687e-03_rb,7.194071e-03_rb,7.019158e-03_rb, &
+       6.854061e-03_rb,6.697986e-03_rb,6.550224e-03_rb,6.410138e-03_rb,6.277153e-03_rb, &
+       6.150751e-03_rb,6.030462e-03_rb,5.915860e-03_rb/)
+
+! ICEFLAG = 3; Fu parameterization. Particle size 5 - 140 micron in 
+! increments of 3 microns.
+! units = m2/g
+! Hexagonal Ice Particle Parameterization
+! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)]
+      absice3(:,1) = (/ &
+! band 1
+       3.110649e-03_rb,4.666352e-02_rb,6.606447e-02_rb,6.531678e-02_rb,6.012598e-02_rb, &
+       5.437494e-02_rb,4.906411e-02_rb,4.441146e-02_rb,4.040585e-02_rb,3.697334e-02_rb, &
+       3.403027e-02_rb,3.149979e-02_rb,2.931596e-02_rb,2.742365e-02_rb,2.577721e-02_rb, &
+       2.433888e-02_rb,2.307732e-02_rb,2.196644e-02_rb,2.098437e-02_rb,2.011264e-02_rb, &
+       1.933561e-02_rb,1.863992e-02_rb,1.801407e-02_rb,1.744812e-02_rb,1.693346e-02_rb, &
+       1.646252e-02_rb,1.602866e-02_rb,1.562600e-02_rb,1.524933e-02_rb,1.489399e-02_rb, &
+       1.455580e-02_rb,1.423098e-02_rb,1.391612e-02_rb,1.360812e-02_rb,1.330413e-02_rb, &
+       1.300156e-02_rb,1.269801e-02_rb,1.239127e-02_rb,1.207928e-02_rb,1.176014e-02_rb, &
+       1.143204e-02_rb,1.109334e-02_rb,1.074243e-02_rb,1.037786e-02_rb,9.998198e-03_rb, &
+       9.602126e-03_rb/)
+      absice3(:,2) = (/ &
+! band 2
+       3.984966e-04_rb,1.681097e-02_rb,2.627680e-02_rb,2.767465e-02_rb,2.700722e-02_rb, &
+       2.579180e-02_rb,2.448677e-02_rb,2.323890e-02_rb,2.209096e-02_rb,2.104882e-02_rb, &
+       2.010547e-02_rb,1.925003e-02_rb,1.847128e-02_rb,1.775883e-02_rb,1.710358e-02_rb, &
+       1.649769e-02_rb,1.593449e-02_rb,1.540829e-02_rb,1.491429e-02_rb,1.444837e-02_rb, &
+       1.400704e-02_rb,1.358729e-02_rb,1.318654e-02_rb,1.280258e-02_rb,1.243346e-02_rb, &
+       1.207750e-02_rb,1.173325e-02_rb,1.139941e-02_rb,1.107487e-02_rb,1.075861e-02_rb, &
+       1.044975e-02_rb,1.014753e-02_rb,9.851229e-03_rb,9.560240e-03_rb,9.274003e-03_rb, &
+       8.992020e-03_rb,8.713845e-03_rb,8.439074e-03_rb,8.167346e-03_rb,7.898331e-03_rb, &
+       7.631734e-03_rb,7.367286e-03_rb,7.104742e-03_rb,6.843882e-03_rb,6.584504e-03_rb, &
+       6.326424e-03_rb/)
+      absice3(:,3) = (/ &
+! band 3
+       6.933163e-02_rb,8.540475e-02_rb,7.701816e-02_rb,6.771158e-02_rb,5.986953e-02_rb, &
+       5.348120e-02_rb,4.824962e-02_rb,4.390563e-02_rb,4.024411e-02_rb,3.711404e-02_rb, &
+       3.440426e-02_rb,3.203200e-02_rb,2.993478e-02_rb,2.806474e-02_rb,2.638464e-02_rb, &
+       2.486516e-02_rb,2.348288e-02_rb,2.221890e-02_rb,2.105780e-02_rb,1.998687e-02_rb, &
+       1.899552e-02_rb,1.807490e-02_rb,1.721750e-02_rb,1.641693e-02_rb,1.566773e-02_rb, &
+       1.496515e-02_rb,1.430509e-02_rb,1.368398e-02_rb,1.309865e-02_rb,1.254634e-02_rb, &
+       1.202456e-02_rb,1.153114e-02_rb,1.106409e-02_rb,1.062166e-02_rb,1.020224e-02_rb, &
+       9.804381e-03_rb,9.426771e-03_rb,9.068205e-03_rb,8.727578e-03_rb,8.403876e-03_rb, &
+       8.096160e-03_rb,7.803564e-03_rb,7.525281e-03_rb,7.260560e-03_rb,7.008697e-03_rb, &
+       6.769036e-03_rb/)
+      absice3(:,4) = (/ &
+! band 4
+       1.765735e-01_rb,1.382700e-01_rb,1.095129e-01_rb,8.987475e-02_rb,7.591185e-02_rb, &
+       6.554169e-02_rb,5.755500e-02_rb,5.122083e-02_rb,4.607610e-02_rb,4.181475e-02_rb, &
+       3.822697e-02_rb,3.516432e-02_rb,3.251897e-02_rb,3.021073e-02_rb,2.817876e-02_rb, &
+       2.637607e-02_rb,2.476582e-02_rb,2.331871e-02_rb,2.201113e-02_rb,2.082388e-02_rb, &
+       1.974115e-02_rb,1.874983e-02_rb,1.783894e-02_rb,1.699922e-02_rb,1.622280e-02_rb, &
+       1.550296e-02_rb,1.483390e-02_rb,1.421064e-02_rb,1.362880e-02_rb,1.308460e-02_rb, &
+       1.257468e-02_rb,1.209611e-02_rb,1.164628e-02_rb,1.122287e-02_rb,1.082381e-02_rb, &
+       1.044725e-02_rb,1.009154e-02_rb,9.755166e-03_rb,9.436783e-03_rb,9.135163e-03_rb, &
+       8.849193e-03_rb,8.577856e-03_rb,8.320225e-03_rb,8.075451e-03_rb,7.842755e-03_rb, &
+       7.621418e-03_rb/)
+      absice3(:,5) = (/ &
+! band 5
+       2.339673e-01_rb,1.692124e-01_rb,1.291656e-01_rb,1.033837e-01_rb,8.562949e-02_rb, &
+       7.273526e-02_rb,6.298262e-02_rb,5.537015e-02_rb,4.927787e-02_rb,4.430246e-02_rb, &
+       4.017061e-02_rb,3.669072e-02_rb,3.372455e-02_rb,3.116995e-02_rb,2.894977e-02_rb, &
+       2.700471e-02_rb,2.528842e-02_rb,2.376420e-02_rb,2.240256e-02_rb,2.117959e-02_rb, &
+       2.007567e-02_rb,1.907456e-02_rb,1.816271e-02_rb,1.732874e-02_rb,1.656300e-02_rb, &
+       1.585725e-02_rb,1.520445e-02_rb,1.459852e-02_rb,1.403419e-02_rb,1.350689e-02_rb, &
+       1.301260e-02_rb,1.254781e-02_rb,1.210941e-02_rb,1.169468e-02_rb,1.130118e-02_rb, &
+       1.092675e-02_rb,1.056945e-02_rb,1.022757e-02_rb,9.899560e-03_rb,9.584021e-03_rb, &
+       9.279705e-03_rb,8.985479e-03_rb,8.700322e-03_rb,8.423306e-03_rb,8.153590e-03_rb, &
+       7.890412e-03_rb/)
+      absice3(:,6) = (/ &
+! band 6
+       1.145369e-01_rb,1.174566e-01_rb,9.917866e-02_rb,8.332990e-02_rb,7.104263e-02_rb, &
+       6.153370e-02_rb,5.405472e-02_rb,4.806281e-02_rb,4.317918e-02_rb,3.913795e-02_rb, &
+       3.574916e-02_rb,3.287437e-02_rb,3.041067e-02_rb,2.828017e-02_rb,2.642292e-02_rb, &
+       2.479206e-02_rb,2.335051e-02_rb,2.206851e-02_rb,2.092195e-02_rb,1.989108e-02_rb, &
+       1.895958e-02_rb,1.811385e-02_rb,1.734245e-02_rb,1.663573e-02_rb,1.598545e-02_rb, &
+       1.538456e-02_rb,1.482700e-02_rb,1.430750e-02_rb,1.382150e-02_rb,1.336499e-02_rb, &
+       1.293447e-02_rb,1.252685e-02_rb,1.213939e-02_rb,1.176968e-02_rb,1.141555e-02_rb, &
+       1.107508e-02_rb,1.074655e-02_rb,1.042839e-02_rb,1.011923e-02_rb,9.817799e-03_rb, &
+       9.522962e-03_rb,9.233688e-03_rb,8.949041e-03_rb,8.668171e-03_rb,8.390301e-03_rb, &
+       8.114723e-03_rb/)
+      absice3(:,7) = (/ &
+! band 7
+       1.222345e-02_rb,5.344230e-02_rb,5.523465e-02_rb,5.128759e-02_rb,4.676925e-02_rb, &
+       4.266150e-02_rb,3.910561e-02_rb,3.605479e-02_rb,3.342843e-02_rb,3.115052e-02_rb, &
+       2.915776e-02_rb,2.739935e-02_rb,2.583499e-02_rb,2.443266e-02_rb,2.316681e-02_rb, &
+       2.201687e-02_rb,2.096619e-02_rb,2.000112e-02_rb,1.911044e-02_rb,1.828481e-02_rb, &
+       1.751641e-02_rb,1.679866e-02_rb,1.612598e-02_rb,1.549360e-02_rb,1.489742e-02_rb, &
+       1.433392e-02_rb,1.380002e-02_rb,1.329305e-02_rb,1.281068e-02_rb,1.235084e-02_rb, &
+       1.191172e-02_rb,1.149171e-02_rb,1.108936e-02_rb,1.070341e-02_rb,1.033271e-02_rb, &
+       9.976220e-03_rb,9.633021e-03_rb,9.302273e-03_rb,8.983216e-03_rb,8.675161e-03_rb, &
+       8.377478e-03_rb,8.089595e-03_rb,7.810986e-03_rb,7.541170e-03_rb,7.279706e-03_rb, &
+       7.026186e-03_rb/)
+      absice3(:,8) = (/ &
+! band 8
+       6.711058e-02_rb,6.918198e-02_rb,6.127484e-02_rb,5.411944e-02_rb,4.836902e-02_rb, &
+       4.375293e-02_rb,3.998077e-02_rb,3.683587e-02_rb,3.416508e-02_rb,3.186003e-02_rb, &
+       2.984290e-02_rb,2.805671e-02_rb,2.645895e-02_rb,2.501733e-02_rb,2.370689e-02_rb, &
+       2.250808e-02_rb,2.140532e-02_rb,2.038609e-02_rb,1.944018e-02_rb,1.855918e-02_rb, &
+       1.773609e-02_rb,1.696504e-02_rb,1.624106e-02_rb,1.555990e-02_rb,1.491793e-02_rb, &
+       1.431197e-02_rb,1.373928e-02_rb,1.319743e-02_rb,1.268430e-02_rb,1.219799e-02_rb, &
+       1.173682e-02_rb,1.129925e-02_rb,1.088393e-02_rb,1.048961e-02_rb,1.011516e-02_rb, &
+       9.759543e-03_rb,9.421813e-03_rb,9.101089e-03_rb,8.796559e-03_rb,8.507464e-03_rb, &
+       8.233098e-03_rb,7.972798e-03_rb,7.725942e-03_rb,7.491940e-03_rb,7.270238e-03_rb, &
+       7.060305e-03_rb/)
+      absice3(:,9) = (/ &
+! band 9
+       1.236780e-01_rb,9.222386e-02_rb,7.383997e-02_rb,6.204072e-02_rb,5.381029e-02_rb, &
+       4.770678e-02_rb,4.296928e-02_rb,3.916131e-02_rb,3.601540e-02_rb,3.335878e-02_rb, &
+       3.107493e-02_rb,2.908247e-02_rb,2.732282e-02_rb,2.575276e-02_rb,2.433968e-02_rb, &
+       2.305852e-02_rb,2.188966e-02_rb,2.081757e-02_rb,1.982974e-02_rb,1.891599e-02_rb, &
+       1.806794e-02_rb,1.727865e-02_rb,1.654227e-02_rb,1.585387e-02_rb,1.520924e-02_rb, &
+       1.460476e-02_rb,1.403730e-02_rb,1.350416e-02_rb,1.300293e-02_rb,1.253153e-02_rb, &
+       1.208808e-02_rb,1.167094e-02_rb,1.127862e-02_rb,1.090979e-02_rb,1.056323e-02_rb, &
+       1.023786e-02_rb,9.932665e-03_rb,9.646744e-03_rb,9.379250e-03_rb,9.129409e-03_rb, &
+       8.896500e-03_rb,8.679856e-03_rb,8.478852e-03_rb,8.292904e-03_rb,8.121463e-03_rb, &
+       7.964013e-03_rb/)
+      absice3(:,10) = (/ &
+! band 10
+       1.655966e-01_rb,1.134205e-01_rb,8.714344e-02_rb,7.129241e-02_rb,6.063739e-02_rb, &
+       5.294203e-02_rb,4.709309e-02_rb,4.247476e-02_rb,3.871892e-02_rb,3.559206e-02_rb, &
+       3.293893e-02_rb,3.065226e-02_rb,2.865558e-02_rb,2.689288e-02_rb,2.532221e-02_rb, &
+       2.391150e-02_rb,2.263582e-02_rb,2.147549e-02_rb,2.041476e-02_rb,1.944089e-02_rb, &
+       1.854342e-02_rb,1.771371e-02_rb,1.694456e-02_rb,1.622989e-02_rb,1.556456e-02_rb, &
+       1.494415e-02_rb,1.436491e-02_rb,1.382354e-02_rb,1.331719e-02_rb,1.284339e-02_rb, &
+       1.239992e-02_rb,1.198486e-02_rb,1.159647e-02_rb,1.123323e-02_rb,1.089375e-02_rb, &
+       1.057679e-02_rb,1.028124e-02_rb,1.000607e-02_rb,9.750376e-03_rb,9.513303e-03_rb, &
+       9.294082e-03_rb,9.092003e-03_rb,8.906412e-03_rb,8.736702e-03_rb,8.582314e-03_rb, &
+       8.442725e-03_rb/)
+      absice3(:,11) = (/ &
+! band 11
+       1.775615e-01_rb,1.180046e-01_rb,8.929607e-02_rb,7.233500e-02_rb,6.108333e-02_rb, &
+       5.303642e-02_rb,4.696927e-02_rb,4.221206e-02_rb,3.836768e-02_rb,3.518576e-02_rb, &
+       3.250063e-02_rb,3.019825e-02_rb,2.819758e-02_rb,2.643943e-02_rb,2.487953e-02_rb, &
+       2.348414e-02_rb,2.222705e-02_rb,2.108762e-02_rb,2.004936e-02_rb,1.909892e-02_rb, &
+       1.822539e-02_rb,1.741975e-02_rb,1.667449e-02_rb,1.598330e-02_rb,1.534084e-02_rb, &
+       1.474253e-02_rb,1.418446e-02_rb,1.366325e-02_rb,1.317597e-02_rb,1.272004e-02_rb, &
+       1.229321e-02_rb,1.189350e-02_rb,1.151915e-02_rb,1.116859e-02_rb,1.084042e-02_rb, &
+       1.053338e-02_rb,1.024636e-02_rb,9.978326e-03_rb,9.728357e-03_rb,9.495613e-03_rb, &
+       9.279327e-03_rb,9.078798e-03_rb,8.893383e-03_rb,8.722488e-03_rb,8.565568e-03_rb, &
+       8.422115e-03_rb/)
+      absice3(:,12) = (/ &
+! band 12
+       9.465447e-02_rb,6.432047e-02_rb,5.060973e-02_rb,4.267283e-02_rb,3.741843e-02_rb, &
+       3.363096e-02_rb,3.073531e-02_rb,2.842405e-02_rb,2.651789e-02_rb,2.490518e-02_rb, &
+       2.351273e-02_rb,2.229056e-02_rb,2.120335e-02_rb,2.022541e-02_rb,1.933763e-02_rb, &
+       1.852546e-02_rb,1.777763e-02_rb,1.708528e-02_rb,1.644134e-02_rb,1.584009e-02_rb, &
+       1.527684e-02_rb,1.474774e-02_rb,1.424955e-02_rb,1.377957e-02_rb,1.333549e-02_rb, &
+       1.291534e-02_rb,1.251743e-02_rb,1.214029e-02_rb,1.178265e-02_rb,1.144337e-02_rb, &
+       1.112148e-02_rb,1.081609e-02_rb,1.052642e-02_rb,1.025178e-02_rb,9.991540e-03_rb, &
+       9.745130e-03_rb,9.512038e-03_rb,9.291797e-03_rb,9.083980e-03_rb,8.888195e-03_rb, &
+       8.704081e-03_rb,8.531306e-03_rb,8.369560e-03_rb,8.218558e-03_rb,8.078032e-03_rb, &
+       7.947730e-03_rb/)
+      absice3(:,13) = (/ &
+! band 13
+       1.560311e-01_rb,9.961097e-02_rb,7.502949e-02_rb,6.115022e-02_rb,5.214952e-02_rb, &
+       4.578149e-02_rb,4.099731e-02_rb,3.724174e-02_rb,3.419343e-02_rb,3.165356e-02_rb, &
+       2.949251e-02_rb,2.762222e-02_rb,2.598073e-02_rb,2.452322e-02_rb,2.321642e-02_rb, &
+       2.203516e-02_rb,2.096002e-02_rb,1.997579e-02_rb,1.907036e-02_rb,1.823401e-02_rb, &
+       1.745879e-02_rb,1.673819e-02_rb,1.606678e-02_rb,1.544003e-02_rb,1.485411e-02_rb, &
+       1.430574e-02_rb,1.379215e-02_rb,1.331092e-02_rb,1.285996e-02_rb,1.243746e-02_rb, &
+       1.204183e-02_rb,1.167164e-02_rb,1.132567e-02_rb,1.100281e-02_rb,1.070207e-02_rb, &
+       1.042258e-02_rb,1.016352e-02_rb,9.924197e-03_rb,9.703953e-03_rb,9.502199e-03_rb, &
+       9.318400e-03_rb,9.152066e-03_rb,9.002749e-03_rb,8.870038e-03_rb,8.753555e-03_rb, &
+       8.652951e-03_rb/)
+      absice3(:,14) = (/ &
+! band 14
+       1.559547e-01_rb,9.896700e-02_rb,7.441231e-02_rb,6.061469e-02_rb,5.168730e-02_rb, &
+       4.537821e-02_rb,4.064106e-02_rb,3.692367e-02_rb,3.390714e-02_rb,3.139438e-02_rb, &
+       2.925702e-02_rb,2.740783e-02_rb,2.578547e-02_rb,2.434552e-02_rb,2.305506e-02_rb, &
+       2.188910e-02_rb,2.082842e-02_rb,1.985789e-02_rb,1.896553e-02_rb,1.814165e-02_rb, &
+       1.737839e-02_rb,1.666927e-02_rb,1.600891e-02_rb,1.539279e-02_rb,1.481712e-02_rb, &
+       1.427865e-02_rb,1.377463e-02_rb,1.330266e-02_rb,1.286068e-02_rb,1.244689e-02_rb, &
+       1.205973e-02_rb,1.169780e-02_rb,1.135989e-02_rb,1.104492e-02_rb,1.075192e-02_rb, &
+       1.048004e-02_rb,1.022850e-02_rb,9.996611e-03_rb,9.783753e-03_rb,9.589361e-03_rb, &
+       9.412924e-03_rb,9.253977e-03_rb,9.112098e-03_rb,8.986903e-03_rb,8.878039e-03_rb, &
+       8.785184e-03_rb/)
+      absice3(:,15) = (/ &
+! band 15
+       1.102926e-01_rb,7.176622e-02_rb,5.530316e-02_rb,4.606056e-02_rb,4.006116e-02_rb, &
+       3.579628e-02_rb,3.256909e-02_rb,3.001360e-02_rb,2.791920e-02_rb,2.615617e-02_rb, &
+       2.464023e-02_rb,2.331426e-02_rb,2.213817e-02_rb,2.108301e-02_rb,2.012733e-02_rb, &
+       1.925493e-02_rb,1.845331e-02_rb,1.771269e-02_rb,1.702531e-02_rb,1.638493e-02_rb, &
+       1.578648e-02_rb,1.522579e-02_rb,1.469940e-02_rb,1.420442e-02_rb,1.373841e-02_rb, &
+       1.329931e-02_rb,1.288535e-02_rb,1.249502e-02_rb,1.212700e-02_rb,1.178015e-02_rb, &
+       1.145348e-02_rb,1.114612e-02_rb,1.085730e-02_rb,1.058633e-02_rb,1.033263e-02_rb, &
+       1.009564e-02_rb,9.874895e-03_rb,9.669960e-03_rb,9.480449e-03_rb,9.306014e-03_rb, &
+       9.146339e-03_rb,9.001138e-03_rb,8.870154e-03_rb,8.753148e-03_rb,8.649907e-03_rb, &
+       8.560232e-03_rb/)
+      absice3(:,16) = (/ &
+! band 16
+       1.688344e-01_rb,1.077072e-01_rb,7.994467e-02_rb,6.403862e-02_rb,5.369850e-02_rb, &
+       4.641582e-02_rb,4.099331e-02_rb,3.678724e-02_rb,3.342069e-02_rb,3.065831e-02_rb, &
+       2.834557e-02_rb,2.637680e-02_rb,2.467733e-02_rb,2.319286e-02_rb,2.188299e-02_rb, &
+       2.071701e-02_rb,1.967121e-02_rb,1.872692e-02_rb,1.786931e-02_rb,1.708641e-02_rb, &
+       1.636846e-02_rb,1.570743e-02_rb,1.509665e-02_rb,1.453052e-02_rb,1.400433e-02_rb, &
+       1.351407e-02_rb,1.305631e-02_rb,1.262810e-02_rb,1.222688e-02_rb,1.185044e-02_rb, &
+       1.149683e-02_rb,1.116436e-02_rb,1.085153e-02_rb,1.055701e-02_rb,1.027961e-02_rb, &
+       1.001831e-02_rb,9.772141e-03_rb,9.540280e-03_rb,9.321966e-03_rb,9.116517e-03_rb, &
+       8.923315e-03_rb,8.741803e-03_rb,8.571472e-03_rb,8.411860e-03_rb,8.262543e-03_rb, &
+       8.123136e-03_rb/)
+
+! For LIQFLAG = 0.
+      absliq0 = 0.0903614_rb
+
+! For LIQFLAG = 1.  In each band, the absorption
+! coefficients are listed for a range of effective radii from 2.5
+! to 59.5 microns in increments of 1.0 micron.
+      absliq1(:, 1) = (/ &
+! band  1
+       1.64047e-03_rb, 6.90533e-02_rb, 7.72017e-02_rb, 7.78054e-02_rb, 7.69523e-02_rb, &
+       7.58058e-02_rb, 7.46400e-02_rb, 7.35123e-02_rb, 7.24162e-02_rb, 7.13225e-02_rb, &
+       6.99145e-02_rb, 6.66409e-02_rb, 6.36582e-02_rb, 6.09425e-02_rb, 5.84593e-02_rb, &
+       5.61743e-02_rb, 5.40571e-02_rb, 5.20812e-02_rb, 5.02245e-02_rb, 4.84680e-02_rb, &
+       4.67959e-02_rb, 4.51944e-02_rb, 4.36516e-02_rb, 4.21570e-02_rb, 4.07015e-02_rb, &
+       3.92766e-02_rb, 3.78747e-02_rb, 3.64886e-02_rb, 3.53632e-02_rb, 3.41992e-02_rb, &
+       3.31016e-02_rb, 3.20643e-02_rb, 3.10817e-02_rb, 3.01490e-02_rb, 2.92620e-02_rb, &
+       2.84171e-02_rb, 2.76108e-02_rb, 2.68404e-02_rb, 2.61031e-02_rb, 2.53966e-02_rb, &
+       2.47189e-02_rb, 2.40678e-02_rb, 2.34418e-02_rb, 2.28392e-02_rb, 2.22586e-02_rb, &
+       2.16986e-02_rb, 2.11580e-02_rb, 2.06356e-02_rb, 2.01305e-02_rb, 1.96417e-02_rb, &
+       1.91682e-02_rb, 1.87094e-02_rb, 1.82643e-02_rb, 1.78324e-02_rb, 1.74129e-02_rb, &
+       1.70052e-02_rb, 1.66088e-02_rb, 1.62231e-02_rb/)
+      absliq1(:, 2) = (/ &
+! band  2
+       2.19486e-01_rb, 1.80687e-01_rb, 1.59150e-01_rb, 1.44731e-01_rb, 1.33703e-01_rb, &
+       1.24355e-01_rb, 1.15756e-01_rb, 1.07318e-01_rb, 9.86119e-02_rb, 8.92739e-02_rb, &
+       8.34911e-02_rb, 7.70773e-02_rb, 7.15240e-02_rb, 6.66615e-02_rb, 6.23641e-02_rb, &
+       5.85359e-02_rb, 5.51020e-02_rb, 5.20032e-02_rb, 4.91916e-02_rb, 4.66283e-02_rb, &
+       4.42813e-02_rb, 4.21236e-02_rb, 4.01330e-02_rb, 3.82905e-02_rb, 3.65797e-02_rb, &
+       3.49869e-02_rb, 3.35002e-02_rb, 3.21090e-02_rb, 3.08957e-02_rb, 2.97601e-02_rb, &
+       2.86966e-02_rb, 2.76984e-02_rb, 2.67599e-02_rb, 2.58758e-02_rb, 2.50416e-02_rb, &
+       2.42532e-02_rb, 2.35070e-02_rb, 2.27997e-02_rb, 2.21284e-02_rb, 2.14904e-02_rb, &
+       2.08834e-02_rb, 2.03051e-02_rb, 1.97536e-02_rb, 1.92271e-02_rb, 1.87239e-02_rb, &
+       1.82425e-02_rb, 1.77816e-02_rb, 1.73399e-02_rb, 1.69162e-02_rb, 1.65094e-02_rb, &
+       1.61187e-02_rb, 1.57430e-02_rb, 1.53815e-02_rb, 1.50334e-02_rb, 1.46981e-02_rb, &
+       1.43748e-02_rb, 1.40628e-02_rb, 1.37617e-02_rb/)
+      absliq1(:, 3) = (/ &
+! band  3
+       2.95174e-01_rb, 2.34765e-01_rb, 1.98038e-01_rb, 1.72114e-01_rb, 1.52083e-01_rb, &
+       1.35654e-01_rb, 1.21613e-01_rb, 1.09252e-01_rb, 9.81263e-02_rb, 8.79448e-02_rb, &
+       8.12566e-02_rb, 7.44563e-02_rb, 6.86374e-02_rb, 6.36042e-02_rb, 5.92094e-02_rb, &
+       5.53402e-02_rb, 5.19087e-02_rb, 4.88455e-02_rb, 4.60951e-02_rb, 4.36124e-02_rb, &
+       4.13607e-02_rb, 3.93096e-02_rb, 3.74338e-02_rb, 3.57119e-02_rb, 3.41261e-02_rb, &
+       3.26610e-02_rb, 3.13036e-02_rb, 3.00425e-02_rb, 2.88497e-02_rb, 2.78077e-02_rb, &
+       2.68317e-02_rb, 2.59158e-02_rb, 2.50545e-02_rb, 2.42430e-02_rb, 2.34772e-02_rb, &
+       2.27533e-02_rb, 2.20679e-02_rb, 2.14181e-02_rb, 2.08011e-02_rb, 2.02145e-02_rb, &
+       1.96561e-02_rb, 1.91239e-02_rb, 1.86161e-02_rb, 1.81311e-02_rb, 1.76673e-02_rb, &
+       1.72234e-02_rb, 1.67981e-02_rb, 1.63903e-02_rb, 1.59989e-02_rb, 1.56230e-02_rb, &
+       1.52615e-02_rb, 1.49138e-02_rb, 1.45791e-02_rb, 1.42565e-02_rb, 1.39455e-02_rb, &
+       1.36455e-02_rb, 1.33559e-02_rb, 1.30761e-02_rb/)
+      absliq1(:, 4) = (/ &
+! band  4
+       3.00925e-01_rb, 2.36949e-01_rb, 1.96947e-01_rb, 1.68692e-01_rb, 1.47190e-01_rb, &
+       1.29986e-01_rb, 1.15719e-01_rb, 1.03568e-01_rb, 9.30028e-02_rb, 8.36658e-02_rb, &
+       7.71075e-02_rb, 7.07002e-02_rb, 6.52284e-02_rb, 6.05024e-02_rb, 5.63801e-02_rb, &
+       5.27534e-02_rb, 4.95384e-02_rb, 4.66690e-02_rb, 4.40925e-02_rb, 4.17664e-02_rb, &
+       3.96559e-02_rb, 3.77326e-02_rb, 3.59727e-02_rb, 3.43561e-02_rb, 3.28662e-02_rb, &
+       3.14885e-02_rb, 3.02110e-02_rb, 2.90231e-02_rb, 2.78948e-02_rb, 2.69109e-02_rb, &
+       2.59884e-02_rb, 2.51217e-02_rb, 2.43058e-02_rb, 2.35364e-02_rb, 2.28096e-02_rb, &
+       2.21218e-02_rb, 2.14700e-02_rb, 2.08515e-02_rb, 2.02636e-02_rb, 1.97041e-02_rb, &
+       1.91711e-02_rb, 1.86625e-02_rb, 1.81769e-02_rb, 1.77126e-02_rb, 1.72683e-02_rb, &
+       1.68426e-02_rb, 1.64344e-02_rb, 1.60427e-02_rb, 1.56664e-02_rb, 1.53046e-02_rb, &
+       1.49565e-02_rb, 1.46214e-02_rb, 1.42985e-02_rb, 1.39871e-02_rb, 1.36866e-02_rb, &
+       1.33965e-02_rb, 1.31162e-02_rb, 1.28453e-02_rb/)
+      absliq1(:, 5) = (/ &
+! band  5
+       2.64691e-01_rb, 2.12018e-01_rb, 1.78009e-01_rb, 1.53539e-01_rb, 1.34721e-01_rb, &
+       1.19580e-01_rb, 1.06996e-01_rb, 9.62772e-02_rb, 8.69710e-02_rb, 7.87670e-02_rb, &
+       7.29272e-02_rb, 6.70920e-02_rb, 6.20977e-02_rb, 5.77732e-02_rb, 5.39910e-02_rb, &
+       5.06538e-02_rb, 4.76866e-02_rb, 4.50301e-02_rb, 4.26374e-02_rb, 4.04704e-02_rb, &
+       3.84981e-02_rb, 3.66948e-02_rb, 3.50394e-02_rb, 3.35141e-02_rb, 3.21038e-02_rb, &
+       3.07957e-02_rb, 2.95788e-02_rb, 2.84438e-02_rb, 2.73790e-02_rb, 2.64390e-02_rb, &
+       2.55565e-02_rb, 2.47263e-02_rb, 2.39437e-02_rb, 2.32047e-02_rb, 2.25056e-02_rb, &
+       2.18433e-02_rb, 2.12149e-02_rb, 2.06177e-02_rb, 2.00495e-02_rb, 1.95081e-02_rb, &
+       1.89917e-02_rb, 1.84984e-02_rb, 1.80269e-02_rb, 1.75755e-02_rb, 1.71431e-02_rb, &
+       1.67283e-02_rb, 1.63303e-02_rb, 1.59478e-02_rb, 1.55801e-02_rb, 1.52262e-02_rb, &
+       1.48853e-02_rb, 1.45568e-02_rb, 1.42400e-02_rb, 1.39342e-02_rb, 1.36388e-02_rb, &
+       1.33533e-02_rb, 1.30773e-02_rb, 1.28102e-02_rb/)
+      absliq1(:, 6) = (/ &
+! band  6
+       8.81182e-02_rb, 1.06745e-01_rb, 9.79753e-02_rb, 8.99625e-02_rb, 8.35200e-02_rb, &
+       7.81899e-02_rb, 7.35939e-02_rb, 6.94696e-02_rb, 6.56266e-02_rb, 6.19148e-02_rb, &
+       5.83355e-02_rb, 5.49306e-02_rb, 5.19642e-02_rb, 4.93325e-02_rb, 4.69659e-02_rb, &
+       4.48148e-02_rb, 4.28431e-02_rb, 4.10231e-02_rb, 3.93332e-02_rb, 3.77563e-02_rb, &
+       3.62785e-02_rb, 3.48882e-02_rb, 3.35758e-02_rb, 3.23333e-02_rb, 3.11536e-02_rb, &
+       3.00310e-02_rb, 2.89601e-02_rb, 2.79365e-02_rb, 2.70502e-02_rb, 2.62618e-02_rb, &
+       2.55025e-02_rb, 2.47728e-02_rb, 2.40726e-02_rb, 2.34013e-02_rb, 2.27583e-02_rb, &
+       2.21422e-02_rb, 2.15522e-02_rb, 2.09869e-02_rb, 2.04453e-02_rb, 1.99260e-02_rb, &
+       1.94280e-02_rb, 1.89501e-02_rb, 1.84913e-02_rb, 1.80506e-02_rb, 1.76270e-02_rb, &
+       1.72196e-02_rb, 1.68276e-02_rb, 1.64500e-02_rb, 1.60863e-02_rb, 1.57357e-02_rb, &
+       1.53975e-02_rb, 1.50710e-02_rb, 1.47558e-02_rb, 1.44511e-02_rb, 1.41566e-02_rb, &
+       1.38717e-02_rb, 1.35960e-02_rb, 1.33290e-02_rb/)
+      absliq1(:, 7) = (/ &
+! band  7
+       4.32174e-02_rb, 7.36078e-02_rb, 6.98340e-02_rb, 6.65231e-02_rb, 6.41948e-02_rb, &
+       6.23551e-02_rb, 6.06638e-02_rb, 5.88680e-02_rb, 5.67124e-02_rb, 5.38629e-02_rb, &
+       4.99579e-02_rb, 4.86289e-02_rb, 4.70120e-02_rb, 4.52854e-02_rb, 4.35466e-02_rb, &
+       4.18480e-02_rb, 4.02169e-02_rb, 3.86658e-02_rb, 3.71992e-02_rb, 3.58168e-02_rb, &
+       3.45155e-02_rb, 3.32912e-02_rb, 3.21390e-02_rb, 3.10538e-02_rb, 3.00307e-02_rb, &
+       2.90651e-02_rb, 2.81524e-02_rb, 2.72885e-02_rb, 2.62821e-02_rb, 2.55744e-02_rb, &
+       2.48799e-02_rb, 2.42029e-02_rb, 2.35460e-02_rb, 2.29108e-02_rb, 2.22981e-02_rb, &
+       2.17079e-02_rb, 2.11402e-02_rb, 2.05945e-02_rb, 2.00701e-02_rb, 1.95663e-02_rb, &
+       1.90824e-02_rb, 1.86174e-02_rb, 1.81706e-02_rb, 1.77411e-02_rb, 1.73281e-02_rb, &
+       1.69307e-02_rb, 1.65483e-02_rb, 1.61801e-02_rb, 1.58254e-02_rb, 1.54835e-02_rb, &
+       1.51538e-02_rb, 1.48358e-02_rb, 1.45288e-02_rb, 1.42322e-02_rb, 1.39457e-02_rb, &
+       1.36687e-02_rb, 1.34008e-02_rb, 1.31416e-02_rb/)
+      absliq1(:, 8) = (/ &
+! band  8
+       1.41881e-01_rb, 7.15419e-02_rb, 6.30335e-02_rb, 6.11132e-02_rb, 6.01931e-02_rb, &
+       5.92420e-02_rb, 5.78968e-02_rb, 5.58876e-02_rb, 5.28923e-02_rb, 4.84462e-02_rb, &
+       4.60839e-02_rb, 4.56013e-02_rb, 4.45410e-02_rb, 4.31866e-02_rb, 4.17026e-02_rb, &
+       4.01850e-02_rb, 3.86892e-02_rb, 3.72461e-02_rb, 3.58722e-02_rb, 3.45749e-02_rb, &
+       3.33564e-02_rb, 3.22155e-02_rb, 3.11494e-02_rb, 3.01541e-02_rb, 2.92253e-02_rb, &
+       2.83584e-02_rb, 2.75488e-02_rb, 2.67925e-02_rb, 2.57692e-02_rb, 2.50704e-02_rb, &
+       2.43918e-02_rb, 2.37350e-02_rb, 2.31005e-02_rb, 2.24888e-02_rb, 2.18996e-02_rb, &
+       2.13325e-02_rb, 2.07870e-02_rb, 2.02623e-02_rb, 1.97577e-02_rb, 1.92724e-02_rb, &
+       1.88056e-02_rb, 1.83564e-02_rb, 1.79241e-02_rb, 1.75079e-02_rb, 1.71070e-02_rb, &
+       1.67207e-02_rb, 1.63482e-02_rb, 1.59890e-02_rb, 1.56424e-02_rb, 1.53077e-02_rb, &
+       1.49845e-02_rb, 1.46722e-02_rb, 1.43702e-02_rb, 1.40782e-02_rb, 1.37955e-02_rb, &
+       1.35219e-02_rb, 1.32569e-02_rb, 1.30000e-02_rb/)
+      absliq1(:, 9) = (/ &
+! band  9
+       6.72726e-02_rb, 6.61013e-02_rb, 6.47866e-02_rb, 6.33780e-02_rb, 6.18985e-02_rb, &
+       6.03335e-02_rb, 5.86136e-02_rb, 5.65876e-02_rb, 5.39839e-02_rb, 5.03536e-02_rb, &
+       4.71608e-02_rb, 4.63630e-02_rb, 4.50313e-02_rb, 4.34526e-02_rb, 4.17876e-02_rb, &
+       4.01261e-02_rb, 3.85171e-02_rb, 3.69860e-02_rb, 3.55442e-02_rb, 3.41954e-02_rb, &
+       3.29384e-02_rb, 3.17693e-02_rb, 3.06832e-02_rb, 2.96745e-02_rb, 2.87374e-02_rb, &
+       2.78662e-02_rb, 2.70557e-02_rb, 2.63008e-02_rb, 2.52450e-02_rb, 2.45424e-02_rb, &
+       2.38656e-02_rb, 2.32144e-02_rb, 2.25885e-02_rb, 2.19873e-02_rb, 2.14099e-02_rb, &
+       2.08554e-02_rb, 2.03230e-02_rb, 1.98116e-02_rb, 1.93203e-02_rb, 1.88482e-02_rb, &
+       1.83944e-02_rb, 1.79578e-02_rb, 1.75378e-02_rb, 1.71335e-02_rb, 1.67440e-02_rb, &
+       1.63687e-02_rb, 1.60069e-02_rb, 1.56579e-02_rb, 1.53210e-02_rb, 1.49958e-02_rb, &
+       1.46815e-02_rb, 1.43778e-02_rb, 1.40841e-02_rb, 1.37999e-02_rb, 1.35249e-02_rb, &
+       1.32585e-02_rb, 1.30004e-02_rb, 1.27502e-02_rb/)
+      absliq1(:,10) = (/ &
+! band 10
+       7.97040e-02_rb, 7.63844e-02_rb, 7.36499e-02_rb, 7.13525e-02_rb, 6.93043e-02_rb, &
+       6.72807e-02_rb, 6.50227e-02_rb, 6.22395e-02_rb, 5.86093e-02_rb, 5.37815e-02_rb, &
+       5.14682e-02_rb, 4.97214e-02_rb, 4.77392e-02_rb, 4.56961e-02_rb, 4.36858e-02_rb, &
+       4.17569e-02_rb, 3.99328e-02_rb, 3.82224e-02_rb, 3.66265e-02_rb, 3.51416e-02_rb, &
+       3.37617e-02_rb, 3.24798e-02_rb, 3.12887e-02_rb, 3.01812e-02_rb, 2.91505e-02_rb, &
+       2.81900e-02_rb, 2.72939e-02_rb, 2.64568e-02_rb, 2.54165e-02_rb, 2.46832e-02_rb, &
+       2.39783e-02_rb, 2.33017e-02_rb, 2.26531e-02_rb, 2.20314e-02_rb, 2.14359e-02_rb, &
+       2.08653e-02_rb, 2.03187e-02_rb, 1.97947e-02_rb, 1.92924e-02_rb, 1.88106e-02_rb, &
+       1.83483e-02_rb, 1.79043e-02_rb, 1.74778e-02_rb, 1.70678e-02_rb, 1.66735e-02_rb, &
+       1.62941e-02_rb, 1.59286e-02_rb, 1.55766e-02_rb, 1.52371e-02_rb, 1.49097e-02_rb, &
+       1.45937e-02_rb, 1.42885e-02_rb, 1.39936e-02_rb, 1.37085e-02_rb, 1.34327e-02_rb, &
+       1.31659e-02_rb, 1.29075e-02_rb, 1.26571e-02_rb/)
+      absliq1(:,11) = (/ &
+! band 11
+       1.49438e-01_rb, 1.33535e-01_rb, 1.21542e-01_rb, 1.11743e-01_rb, 1.03263e-01_rb, &
+       9.55774e-02_rb, 8.83382e-02_rb, 8.12943e-02_rb, 7.42533e-02_rb, 6.70609e-02_rb, &
+       6.38761e-02_rb, 5.97788e-02_rb, 5.59841e-02_rb, 5.25318e-02_rb, 4.94132e-02_rb, &
+       4.66014e-02_rb, 4.40644e-02_rb, 4.17706e-02_rb, 3.96910e-02_rb, 3.77998e-02_rb, &
+       3.60742e-02_rb, 3.44947e-02_rb, 3.30442e-02_rb, 3.17079e-02_rb, 3.04730e-02_rb, &
+       2.93283e-02_rb, 2.82642e-02_rb, 2.72720e-02_rb, 2.61789e-02_rb, 2.53277e-02_rb, &
+       2.45237e-02_rb, 2.37635e-02_rb, 2.30438e-02_rb, 2.23615e-02_rb, 2.17140e-02_rb, &
+       2.10987e-02_rb, 2.05133e-02_rb, 1.99557e-02_rb, 1.94241e-02_rb, 1.89166e-02_rb, &
+       1.84317e-02_rb, 1.79679e-02_rb, 1.75238e-02_rb, 1.70983e-02_rb, 1.66901e-02_rb, &
+       1.62983e-02_rb, 1.59219e-02_rb, 1.55599e-02_rb, 1.52115e-02_rb, 1.48761e-02_rb, &
+       1.45528e-02_rb, 1.42411e-02_rb, 1.39402e-02_rb, 1.36497e-02_rb, 1.33690e-02_rb, &
+       1.30976e-02_rb, 1.28351e-02_rb, 1.25810e-02_rb/)
+      absliq1(:,12) = (/ &
+! band 12
+       3.71985e-02_rb, 3.88586e-02_rb, 3.99070e-02_rb, 4.04351e-02_rb, 4.04610e-02_rb, &
+       3.99834e-02_rb, 3.89953e-02_rb, 3.74886e-02_rb, 3.54551e-02_rb, 3.28870e-02_rb, &
+       3.32576e-02_rb, 3.22444e-02_rb, 3.12384e-02_rb, 3.02584e-02_rb, 2.93146e-02_rb, &
+       2.84120e-02_rb, 2.75525e-02_rb, 2.67361e-02_rb, 2.59618e-02_rb, 2.52280e-02_rb, &
+       2.45327e-02_rb, 2.38736e-02_rb, 2.32487e-02_rb, 2.26558e-02_rb, 2.20929e-02_rb, &
+       2.15579e-02_rb, 2.10491e-02_rb, 2.05648e-02_rb, 1.99749e-02_rb, 1.95704e-02_rb, &
+       1.91731e-02_rb, 1.87839e-02_rb, 1.84032e-02_rb, 1.80315e-02_rb, 1.76689e-02_rb, &
+       1.73155e-02_rb, 1.69712e-02_rb, 1.66362e-02_rb, 1.63101e-02_rb, 1.59928e-02_rb, &
+       1.56842e-02_rb, 1.53840e-02_rb, 1.50920e-02_rb, 1.48080e-02_rb, 1.45318e-02_rb, &
+       1.42631e-02_rb, 1.40016e-02_rb, 1.37472e-02_rb, 1.34996e-02_rb, 1.32586e-02_rb, &
+       1.30239e-02_rb, 1.27954e-02_rb, 1.25728e-02_rb, 1.23559e-02_rb, 1.21445e-02_rb, &
+       1.19385e-02_rb, 1.17376e-02_rb, 1.15417e-02_rb/)
+      absliq1(:,13) = (/ &
+! band 13
+       3.11868e-02_rb, 4.48357e-02_rb, 4.90224e-02_rb, 4.96406e-02_rb, 4.86806e-02_rb, &
+       4.69610e-02_rb, 4.48630e-02_rb, 4.25795e-02_rb, 4.02138e-02_rb, 3.78236e-02_rb, &
+       3.74266e-02_rb, 3.60384e-02_rb, 3.47074e-02_rb, 3.34434e-02_rb, 3.22499e-02_rb, &
+       3.11264e-02_rb, 3.00704e-02_rb, 2.90784e-02_rb, 2.81463e-02_rb, 2.72702e-02_rb, &
+       2.64460e-02_rb, 2.56698e-02_rb, 2.49381e-02_rb, 2.42475e-02_rb, 2.35948e-02_rb, &
+       2.29774e-02_rb, 2.23925e-02_rb, 2.18379e-02_rb, 2.11793e-02_rb, 2.07076e-02_rb, &
+       2.02470e-02_rb, 1.97981e-02_rb, 1.93613e-02_rb, 1.89367e-02_rb, 1.85243e-02_rb, &
+       1.81240e-02_rb, 1.77356e-02_rb, 1.73588e-02_rb, 1.69935e-02_rb, 1.66392e-02_rb, &
+       1.62956e-02_rb, 1.59624e-02_rb, 1.56393e-02_rb, 1.53259e-02_rb, 1.50219e-02_rb, &
+       1.47268e-02_rb, 1.44404e-02_rb, 1.41624e-02_rb, 1.38925e-02_rb, 1.36302e-02_rb, &
+       1.33755e-02_rb, 1.31278e-02_rb, 1.28871e-02_rb, 1.26530e-02_rb, 1.24253e-02_rb, &
+       1.22038e-02_rb, 1.19881e-02_rb, 1.17782e-02_rb/)
+      absliq1(:,14) = (/ &
+! band 14
+       1.58988e-02_rb, 3.50652e-02_rb, 4.00851e-02_rb, 4.07270e-02_rb, 3.98101e-02_rb, &
+       3.83306e-02_rb, 3.66829e-02_rb, 3.50327e-02_rb, 3.34497e-02_rb, 3.19609e-02_rb, &
+       3.13712e-02_rb, 3.03348e-02_rb, 2.93415e-02_rb, 2.83973e-02_rb, 2.75037e-02_rb, &
+       2.66604e-02_rb, 2.58654e-02_rb, 2.51161e-02_rb, 2.44100e-02_rb, 2.37440e-02_rb, &
+       2.31154e-02_rb, 2.25215e-02_rb, 2.19599e-02_rb, 2.14282e-02_rb, 2.09242e-02_rb, &
+       2.04459e-02_rb, 1.99915e-02_rb, 1.95594e-02_rb, 1.90254e-02_rb, 1.86598e-02_rb, &
+       1.82996e-02_rb, 1.79455e-02_rb, 1.75983e-02_rb, 1.72584e-02_rb, 1.69260e-02_rb, &
+       1.66013e-02_rb, 1.62843e-02_rb, 1.59752e-02_rb, 1.56737e-02_rb, 1.53799e-02_rb, &
+       1.50936e-02_rb, 1.48146e-02_rb, 1.45429e-02_rb, 1.42782e-02_rb, 1.40203e-02_rb, &
+       1.37691e-02_rb, 1.35243e-02_rb, 1.32858e-02_rb, 1.30534e-02_rb, 1.28270e-02_rb, &
+       1.26062e-02_rb, 1.23909e-02_rb, 1.21810e-02_rb, 1.19763e-02_rb, 1.17766e-02_rb, &
+       1.15817e-02_rb, 1.13915e-02_rb, 1.12058e-02_rb/)
+      absliq1(:,15) = (/ &
+! band 15
+       5.02079e-03_rb, 2.17615e-02_rb, 2.55449e-02_rb, 2.59484e-02_rb, 2.53650e-02_rb, &
+       2.45281e-02_rb, 2.36843e-02_rb, 2.29159e-02_rb, 2.22451e-02_rb, 2.16716e-02_rb, &
+       2.11451e-02_rb, 2.05817e-02_rb, 2.00454e-02_rb, 1.95372e-02_rb, 1.90567e-02_rb, &
+       1.86028e-02_rb, 1.81742e-02_rb, 1.77693e-02_rb, 1.73866e-02_rb, 1.70244e-02_rb, &
+       1.66815e-02_rb, 1.63563e-02_rb, 1.60477e-02_rb, 1.57544e-02_rb, 1.54755e-02_rb, &
+       1.52097e-02_rb, 1.49564e-02_rb, 1.47146e-02_rb, 1.43684e-02_rb, 1.41728e-02_rb, &
+       1.39762e-02_rb, 1.37797e-02_rb, 1.35838e-02_rb, 1.33891e-02_rb, 1.31961e-02_rb, &
+       1.30051e-02_rb, 1.28164e-02_rb, 1.26302e-02_rb, 1.24466e-02_rb, 1.22659e-02_rb, &
+       1.20881e-02_rb, 1.19131e-02_rb, 1.17412e-02_rb, 1.15723e-02_rb, 1.14063e-02_rb, &
+       1.12434e-02_rb, 1.10834e-02_rb, 1.09264e-02_rb, 1.07722e-02_rb, 1.06210e-02_rb, &
+       1.04725e-02_rb, 1.03269e-02_rb, 1.01839e-02_rb, 1.00436e-02_rb, 9.90593e-03_rb, &
+       9.77080e-03_rb, 9.63818e-03_rb, 9.50800e-03_rb/)
+      absliq1(:,16) = (/ &
+! band 16
+       5.64971e-02_rb, 9.04736e-02_rb, 8.11726e-02_rb, 7.05450e-02_rb, 6.20052e-02_rb, &
+       5.54286e-02_rb, 5.03503e-02_rb, 4.63791e-02_rb, 4.32290e-02_rb, 4.06959e-02_rb, &
+       3.74690e-02_rb, 3.52964e-02_rb, 3.33799e-02_rb, 3.16774e-02_rb, 3.01550e-02_rb, &
+       2.87856e-02_rb, 2.75474e-02_rb, 2.64223e-02_rb, 2.53953e-02_rb, 2.44542e-02_rb, &
+       2.35885e-02_rb, 2.27894e-02_rb, 2.20494e-02_rb, 2.13622e-02_rb, 2.07222e-02_rb, &
+       2.01246e-02_rb, 1.95654e-02_rb, 1.90408e-02_rb, 1.84398e-02_rb, 1.80021e-02_rb, &
+       1.75816e-02_rb, 1.71775e-02_rb, 1.67889e-02_rb, 1.64152e-02_rb, 1.60554e-02_rb, &
+       1.57089e-02_rb, 1.53751e-02_rb, 1.50531e-02_rb, 1.47426e-02_rb, 1.44428e-02_rb, &
+       1.41532e-02_rb, 1.38734e-02_rb, 1.36028e-02_rb, 1.33410e-02_rb, 1.30875e-02_rb, &
+       1.28420e-02_rb, 1.26041e-02_rb, 1.23735e-02_rb, 1.21497e-02_rb, 1.19325e-02_rb, &
+       1.17216e-02_rb, 1.15168e-02_rb, 1.13177e-02_rb, 1.11241e-02_rb, 1.09358e-02_rb, &
+       1.07525e-02_rb, 1.05741e-02_rb, 1.04003e-02_rb/)
+
+      end subroutine lwcldpr
+
+      end module rrtmg_lw_init
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_rad.nomcica.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_rad.nomcica.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_rad.nomcica.f90	(revision 1585)
@@ -0,0 +1,903 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_rad.nomcica.f90,v $
+!     author:    $Author: miacono $
+!     revision:  $Revision: 1.12 $
+!     created:   $Date: 2011/04/08 20:25:01 $
+!
+
+       module rrtmg_lw_rad
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+!
+! ****************************************************************************
+! *                                                                          *
+! *                              RRTMG_LW                                    *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                   a rapid radiative transfer model                       *
+! *                       for the longwave 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                                *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                       email:  emlawer@aer.com                            *
+! *                       email:  jdelamer@aer.com                           *
+! *                       email:  miacono@aer.com                            *
+! *                                                                          *
+! *        The authors wish to acknowledge the contributions of the          *
+! *        following people:  Steven J. Taubman, Karen Cady-Pereira,         *
+! *        Patrick D. Brown, Ronald E. Farren, Luke Chen, Robert Bergstrom.  *
+! *                                                                          *
+! ****************************************************************************
+
+! -------- Modules --------
+      use parkind, only : im => kind_im, rb => kind_rb
+      use rrlw_vsn
+      use rrtmg_lw_cldprop, only: cldprop
+! *** Move the required call to rrtmg_lw_ini below and the following 
+! use association to the GCM initialization area ***
+!      use rrtmg_lw_init, only: rrtmg_lw_ini
+      use rrtmg_lw_rtrn, only: rtrn
+      use rrtmg_lw_rtrnmr, only: rtrnmr
+      use rrtmg_lw_setcoef, only: setcoef
+      use rrtmg_lw_taumol, only: taumol
+
+      implicit none
+
+! public interfaces/functions/subroutines
+      public :: rrtmg_lw, inatm
+
+!------------------------------------------------------------------
+      contains
+!------------------------------------------------------------------
+
+!------------------------------------------------------------------
+! Public subroutines
+!------------------------------------------------------------------
+
+      subroutine rrtmg_lw &
+            (ncol    ,nlay    ,icld    ,idrv    , &
+             play    ,plev    ,tlay    ,tlev    ,tsfc    , &
+             h2ovmr  ,o3vmr   ,co2vmr  ,ch4vmr  ,n2ovmr  ,o2vmr, &
+             cfc11vmr,cfc12vmr,cfc22vmr,ccl4vmr ,emis    , &
+             inflglw ,iceflglw,liqflglw,cldfr   , &
+             taucld  ,cicewp  ,cliqwp  ,reice   ,reliq   , &
+             tauaer  , &
+             uflx    ,dflx    ,hr      ,uflxc   ,dflxc,  hrc, &
+             duflx_dt,duflxc_dt )
+
+! -------- Description --------
+
+! This program is the driver subroutine for RRTMG_LW, the AER LW radiation 
+! model for application to GCMs, that has been adapted from RRTM_LW for
+! improved efficiency.
+!
+! NOTE: The call to RRTMG_LW_INI should be moved to the GCM initialization
+!  area, since this has to be called only once. 
+!
+! This routine:
+!    a) calls INATM to read in the atmospheric profile from GCM;
+!       all layering in RRTMG is ordered from surface to toa. 
+!    b) calls CLDPROP to set cloud optical depth based on input
+!       cloud properties
+!    c) calls SETCOEF to calculate various quantities needed for 
+!       the radiative transfer algorithm
+!    d) calls TAUMOL to calculate gaseous optical depths for each 
+!       of the 16 spectral bands
+!    e) calls RTRNMR (for both clear and cloudy profiles) to perform the
+!       radiative transfer calculation with a maximum-random cloud
+!       overlap method, or calls RTRN to use random cloud overlap.
+!    f) passes the necessary fluxes and cooling rates back to GCM
+!
+! Two modes of operation are possible:
+!     The mode is chosen by using either rrtmg_lw.nomcica.f90 (to not use
+!     McICA) or rrtmg_lw.f90 (to use McICA) to interface with a GCM. 
+!
+!    1) Standard, single forward model calculation (imca = 0)
+!    2) Monte Carlo Independent Column Approximation (McICA, Pincus et al., 
+!       JC, 2003) method is applied to the forward model calculation (imca = 1)
+!
+! Two methods of cloud property input are possible:
+!     Cloud properties can be input in one of two ways (controlled by input 
+!     flags inflglw, iceflglw, and liqflglw; see text file rrtmg_lw_instructions
+!     and subroutine rrtmg_lw_cldprop.f90 for further details):
+!
+!    1) Input cloud fraction and cloud optical depth directly (inflglw = 0)
+!    2) Input cloud fraction and cloud physical properties (inflglw = 1 or 2);  
+!       cloud optical properties are calculated by cldprop or cldprmc based
+!       on input settings of iceflglw and liqflglw.  Ice particle size provided
+!       must be appropriately defined for the ice parameterization selected. 
+!
+! One method of aerosol property input is possible:
+!     Aerosol properties can be input in only one way (controlled by input 
+!     flag iaer; see text file rrtmg_lw_instructions for further details):
+!
+!    1) Input aerosol optical depth directly by layer and spectral band (iaer=10);
+!       band average optical depth at the mid-point of each spectral band.
+!       RRTMG_LW currently treats only aerosol absorption;
+!       scattering capability is not presently available.
+!
+! The optional calculation of the change in upward flux as a function of surface 
+! temperature is available (controlled by input flag idrv).  This can be utilized 
+! to approximate adjustments to the upward flux profile caused only by a change in 
+! surface temperature between full radiation calls.  This feature uses the pre-
+! calculated derivative of the Planck function with respect to surface temperature. 
+!
+!    1) Normal forward calculation for the input profile (idrv=0)
+!    2) Normal forward calculation with optional calculation of the change
+!       in upward flux as a function of surface temperature for clear sky
+!       and total sky flux.  Flux partial derivatives are provided in arrays
+!       duflx_dt and duflxc_dt for total and clear sky.  (idrv=1)
+!
+!
+! ------- Modifications -------
+!
+! This version of RRTMG_LW has been modified from RRTM_LW to use a reduced 
+! set of g-points for application to GCMs.  
+!
+!-- Original version (derived from RRTM_LW), reduction of g-points, other
+!   revisions for use with GCMs.  
+!     1999: M. J. Iacono, AER, Inc.
+!-- Adapted for use with NCAR/CAM.
+!     May 2004: M. J. Iacono, AER, Inc.
+!-- Conversion to F90 formatting for consistency with rrtmg_sw.
+!     Feb 2007: M. J. Iacono, AER, Inc.
+!-- Modifications to formatting to use assumed-shape arrays.
+!     Aug 2007: M. J. Iacono, AER, Inc.
+!-- Modified to add longwave aerosol absorption.
+!     Apr 2008: M. J. Iacono, AER, Inc.
+!-- Added capability to calculate derivative of upward flux wrt surface temperature. 
+!     Nov 2009: M. J. Iacono, E. J. Mlawer, AER, Inc.
+
+! --------- Modules ----------
+
+      use parrrtm, only : nbndlw, ngptlw, maxxsec, mxmol
+      use rrlw_con, only: fluxfac, heatfac, oneminus, pi
+      use rrlw_wvn, only: ng, ngb, nspa, nspb, wavenum1, wavenum2, delwave
+
+! ------- Declarations -------
+
+! ----- Input -----
+! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
+! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol) 
+      integer(kind=im), intent(in) :: ncol            ! Number of horizontal columns
+      integer(kind=im), intent(in) :: nlay            ! Number of model layers
+      integer(kind=im), intent(inout) :: icld         ! Cloud overlap method
+                                                      !    0: Clear only
+                                                      !    1: Random
+                                                      !    2: Maximum/random
+                                                      !    3: Maximum
+      integer(kind=im), intent(in) :: idrv            ! Flag for calculation of dFdT, the change
+                                                      !    in upward flux as a function of 
+                                                      !    surface temperature [0=off, 1=on]
+                                                      !    0: Normal forward calculation
+                                                      !    1: Normal forward calculation with
+                                                      !       duflx_dt and duflxc_dt output
+
+      real(kind=rb), intent(in) :: play(:,:)          ! Layer pressures (hPa, mb)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: plev(:,:)          ! Interface pressures (hPa, mb)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tlay(:,:)          ! Layer temperatures (K)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: tlev(:,:)          ! Interface temperatures (K)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tsfc(:)            ! Surface temperature (K)
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: h2ovmr(:,:)        ! H2O volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o3vmr(:,:)         ! O3 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: co2vmr(:,:)        ! CO2 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: ch4vmr(:,:)        ! Methane volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: n2ovmr(:,:)        ! Nitrous oxide volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o2vmr(:,:)         ! Oxygen volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cfc11vmr(:,:)      ! CFC11 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cfc12vmr(:,:)      ! CFC12 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cfc22vmr(:,:)      ! CFC22 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: ccl4vmr(:,:)       ! CCL4 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: emis(:,:)          ! Surface emissivity
+                                                      !    Dimensions: (ncol,nbndlw)
+
+      integer(kind=im), intent(in) :: inflglw         ! Flag for cloud optical properties
+      integer(kind=im), intent(in) :: iceflglw        ! Flag for ice particle specification
+      integer(kind=im), intent(in) :: liqflglw        ! Flag for liquid droplet specification
+
+      real(kind=rb), intent(in) :: cldfr(:,:)         ! Cloud fraction
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cicewp(:,:)        ! Cloud ice water path (g/m2)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cliqwp(:,:)        ! Cloud liquid water path (g/m2)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: reice(:,:)         ! Cloud ice particle effective size (microns)
+                                                      !    Dimensions: (ncol,nlay)
+                                                      ! specific definition of reice 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(kind=rb), intent(in) :: reliq(:,:)         ! Cloud water drop effective radius (microns)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: taucld(:,:,:)      ! In-cloud optical depth
+                                                      !    Dimensions: (nbndlw,ncol,nlay)
+!      real(kind=rb), intent(in) :: ssacld(:,:,:)     ! In-cloud single scattering albedo
+                                                      !    Dimensions: (nbndlw,ncol,nlay)
+                                                      !   for future expansion 
+                                                      !   (lw scattering not yet available)
+!      real(kind=rb), intent(in) :: asmcld(:,:,:)     ! In-cloud asymmetry parameter
+                                                      !    Dimensions: (nbndlw,ncol,nlay)
+                                                      !   for future expansion 
+                                                      !   (lw scattering not yet available)
+      real(kind=rb), intent(in) :: tauaer(:,:,:)      ! aerosol optical depth
+                                                      !    Dimensions: (ncol,nlay,nbndlw)
+!      real(kind=rb), intent(in) :: ssaaer(:,:,:)     ! aerosol single scattering albedo
+                                                      !    Dimensions: (ncol,nlay,nbndlw)
+                                                      !   for future expansion 
+                                                      !   (lw aerosols/scattering not yet available)
+!      real(kind=rb), intent(in) :: asmaer(:,:,:)     ! aerosol asymmetry parameter
+                                                      !    Dimensions: (ncol,nlay,nbndlw)
+                                                      !   for future expansion 
+                                                      !   (lw aerosols/scattering not yet available)
+
+
+! ----- Output -----
+
+      real(kind=rb), intent(out) :: uflx(:,:)         ! Total sky longwave upward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: dflx(:,:)         ! Total sky longwave downward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: hr(:,:)           ! Total sky longwave radiative heating rate (K/d)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(out) :: uflxc(:,:)        ! Clear sky longwave upward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: dflxc(:,:)        ! Clear sky longwave downward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: hrc(:,:)          ! Clear sky longwave radiative heating rate (K/d)
+                                                      !    Dimensions: (ncol,nlay)
+
+! ----- Optional Output -----
+      real(kind=rb), intent(out), optional :: duflx_dt(:,:)     
+                                                      ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out), optional :: duflxc_dt(:,:)    
+                                                      ! change in clear sky upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (ncol,nlay+1)
+
+! ----- Local -----
+
+! Control
+      integer(kind=im) :: nlayers             ! total number of layers
+      integer(kind=im) :: istart              ! beginning band of calculation
+      integer(kind=im) :: iend                ! ending band of calculation
+      integer(kind=im) :: iout                ! output option flag (inactive)
+      integer(kind=im) :: iaer                ! aerosol option flag
+      integer(kind=im) :: iplon               ! column loop index
+      integer(kind=im) :: imca                ! flag for mcica [0=off, 1=on]
+      integer(kind=im) :: k                   ! layer loop index
+      integer(kind=im) :: ig                  ! g-point loop index
+
+! Atmosphere
+      real(kind=rb) :: pavel(nlay+1)          ! layer pressures (mb) 
+      real(kind=rb) :: tavel(nlay+1)          ! layer temperatures (K)
+      real(kind=rb) :: pz(0:nlay+1)           ! level (interface) pressures (hPa, mb)
+      real(kind=rb) :: tz(0:nlay+1)           ! level (interface) temperatures (K)
+      real(kind=rb) :: tbound                 ! surface temperature (K)
+      real(kind=rb) :: coldry(nlay+1)         ! dry air column density (mol/cm2)
+      real(kind=rb) :: wbrodl(nlay+1)         ! broadening gas column density (mol/cm2)
+      real(kind=rb) :: wkl(mxmol,nlay+1)      ! molecular amounts (mol/cm-2)
+      real(kind=rb) :: wx(maxxsec,nlay+1)     ! cross-section amounts (mol/cm-2)
+      real(kind=rb) :: pwvcm                  ! precipitable water vapor (cm)
+      real(kind=rb) :: semiss(nbndlw)         ! lw surface emissivity
+      real(kind=rb) :: fracs(nlay+1,ngptlw)   ! 
+      real(kind=rb) :: taug(nlay+1,ngptlw)    ! gaseous optical depths
+      real(kind=rb) :: taut(nlay+1,ngptlw)    ! gaseous + aerosol optical depths
+
+      real(kind=rb) :: taua(nlay+1,nbndlw)    ! aerosol optical depth
+!      real(kind=rb) :: ssaa(nlay+1,nbndlw)   ! aerosol single scattering albedo
+                                              !   for future expansion 
+                                              !   (lw aerosols/scattering not yet available)
+!      real(kind=rb) :: asma(nlay+1,nbndlw)   ! aerosol asymmetry parameter
+                                              !   for future expansion 
+                                              !   (lw aerosols/scattering not yet available)
+
+! Atmosphere - setcoef
+      integer(kind=im) :: laytrop             ! tropopause layer index
+      integer(kind=im) :: jp(nlay+1)          ! lookup table index 
+      integer(kind=im) :: jt(nlay+1)          ! lookup table index 
+      integer(kind=im) :: jt1(nlay+1)         ! lookup table index 
+      real(kind=rb) :: planklay(nlay+1,nbndlw)! 
+      real(kind=rb) :: planklev(0:nlay+1,nbndlw)! 
+      real(kind=rb) :: plankbnd(nbndlw)       ! 
+      real(kind=rb) :: dplankbnd_dt(nbndlw)   ! 
+
+      real(kind=rb) :: colh2o(nlay+1)         ! column amount (h2o)
+      real(kind=rb) :: colco2(nlay+1)         ! column amount (co2)
+      real(kind=rb) :: colo3(nlay+1)          ! column amount (o3)
+      real(kind=rb) :: coln2o(nlay+1)         ! column amount (n2o)
+      real(kind=rb) :: colco(nlay+1)          ! column amount (co)
+      real(kind=rb) :: colch4(nlay+1)         ! column amount (ch4)
+      real(kind=rb) :: colo2(nlay+1)          ! column amount (o2)
+      real(kind=rb) :: colbrd(nlay+1)         ! column amount (broadening gases)
+
+      integer(kind=im) :: indself(nlay+1)
+      integer(kind=im) :: indfor(nlay+1)
+      real(kind=rb) :: selffac(nlay+1)
+      real(kind=rb) :: selffrac(nlay+1)
+      real(kind=rb) :: forfac(nlay+1)
+      real(kind=rb) :: forfrac(nlay+1)
+
+      integer(kind=im) :: indminor(nlay+1)
+      real(kind=rb) :: minorfrac(nlay+1)
+      real(kind=rb) :: scaleminor(nlay+1)
+      real(kind=rb) :: scaleminorn2(nlay+1)
+
+      real(kind=rb) :: &                      !
+                         fac00(nlay+1), fac01(nlay+1), &
+                         fac10(nlay+1), fac11(nlay+1) 
+      real(kind=rb) :: &                      !
+                         rat_h2oco2(nlay+1),rat_h2oco2_1(nlay+1), &
+                         rat_h2oo3(nlay+1),rat_h2oo3_1(nlay+1), &
+                         rat_h2on2o(nlay+1),rat_h2on2o_1(nlay+1), &
+                         rat_h2och4(nlay+1),rat_h2och4_1(nlay+1), &
+                         rat_n2oco2(nlay+1),rat_n2oco2_1(nlay+1), &
+                         rat_o3co2(nlay+1),rat_o3co2_1(nlay+1)
+
+! Atmosphere/clouds - cldprop
+      integer(kind=im) :: ncbands             ! number of cloud spectral bands
+      integer(kind=im) :: inflag              ! flag for cloud property method
+      integer(kind=im) :: iceflag             ! flag for ice cloud properties
+      integer(kind=im) :: liqflag             ! flag for liquid cloud properties
+
+      real(kind=rb) :: cldfrac(nlay+1)        ! layer cloud fraction
+      real(kind=rb) :: tauc(nbndlw,nlay+1)    ! in-cloud optical depth
+!      real(kind=rb) :: ssac(nbndlw,nlay+1)   ! in-cloud single scattering albedo
+                                              !   for future expansion 
+                                              !   (lw scattering not yet available)
+!      real(kind=rb) :: asmc(nbndlw,nlay+1)   ! in-cloud asymmetry parameter
+                                              !   for future expansion 
+                                              !   (lw scattering not yet available)
+      real(kind=rb) :: ciwp(nlay+1)           ! cloud ice water path
+      real(kind=rb) :: clwp(nlay+1)           ! cloud liquid water path
+      real(kind=rb) :: rel(nlay+1)            ! cloud liquid particle effective radius (microns)
+      real(kind=rb) :: rei(nlay+1)            ! cloud ice particle effective size (microns)
+      real(kind=rb) :: taucloud(nlay+1,nbndlw)! layer in-cloud optical depth
+
+! Output
+      real(kind=rb) :: totuflux(0:nlay+1)     ! upward longwave flux (w/m2)
+      real(kind=rb) :: totdflux(0:nlay+1)     ! downward longwave flux (w/m2)
+      real(kind=rb) :: fnet(0:nlay+1)         ! net longwave flux (w/m2)
+      real(kind=rb) :: htr(0:nlay+1)          ! longwave heating rate (k/day)
+      real(kind=rb) :: totuclfl(0:nlay+1)     ! clear sky upward longwave flux (w/m2)
+      real(kind=rb) :: totdclfl(0:nlay+1)     ! clear sky downward longwave flux (w/m2)
+      real(kind=rb) :: fnetc(0:nlay+1)        ! clear sky net longwave flux (w/m2)
+      real(kind=rb) :: htrc(0:nlay+1)         ! clear sky longwave heating rate (k/day)
+      real(kind=rb) :: dtotuflux_dt(0:nlay+1) ! change in upward longwave flux (w/m2/k)
+                                              ! with respect to surface temperature
+      real(kind=rb) :: dtotuclfl_dt(0:nlay+1) ! change in clear sky upward longwave flux (w/m2/k)
+                                              ! with respect to surface temperature
+
+!
+! Initializations
+
+      oneminus = 1._rb - 1.e-6_rb
+      pi = 2._rb*asin(1._rb)
+      fluxfac = pi * 2.e4_rb                  ! orig:   fluxfac = pi * 2.d4  
+      istart = 1
+      iend = 16
+      iout = 0
+
+! Set imca to select calculation type:
+!  imca = 0, use standard forward model calculation
+!  imca = 1, use McICA for Monte Carlo treatment of sub-grid cloud variability
+
+! *** This version does not use McICA (imca = 0) ***
+
+! Set default icld to select of clear or cloud calculation and cloud overlap method  
+! icld = 0, clear only
+! icld = 1, with clouds using random cloud overlap
+! icld = 2, with clouds using maximum/random cloud overlap
+! icld = 3, with clouds using maximum cloud overlap (McICA only)
+      if (icld.lt.0.or.icld.gt.3) icld = 2
+
+! Set iaer to select aerosol option
+! iaer = 0, no aerosols
+! icld = 10, input total aerosol optical depth (tauaer) directly
+      iaer = 10
+
+! Call model and data initialization, compute lookup tables, perform
+! reduction of g-points from 256 to 140 for input absorption coefficient 
+! data and other arrays.
+!
+! In a GCM this call should be placed in the model initialization
+! area, since this has to be called only once.  
+!      call rrtmg_lw_ini(cpdair)
+
+!  This is the main longitude/column loop within RRTMG.
+      do iplon = 1, ncol
+
+!  Prepare atmospheric profile from GCM for use in RRTMG, and define
+!  other input parameters.  
+
+         call inatm (iplon, nlay, icld, iaer, &
+              play, plev, tlay, tlev, tsfc, h2ovmr, &
+              o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, cfc11vmr, cfc12vmr, &
+              cfc22vmr, ccl4vmr, emis, inflglw, iceflglw, liqflglw, &
+              cldfr, taucld, cicewp, cliqwp, reice, reliq, tauaer, &
+              nlayers, pavel, pz, tavel, tz, tbound, semiss, coldry, &
+              wkl, wbrodl, wx, pwvcm, inflag, iceflag, liqflag, &
+              cldfrac, tauc, ciwp, clwp, rei, rel, taua)
+
+!  For cloudy atmosphere, use cldprop to set cloud optical properties based on
+!  input cloud physical properties.  Select method based on choices described
+!  in cldprop.  Cloud fraction, water path, liquid droplet and ice particle
+!  effective radius must be passed into cldprop.  Cloud fraction and cloud
+!  optical depth are transferred to rrtmg_lw arrays in cldprop.  
+
+         call cldprop(nlayers, inflag, iceflag, liqflag, cldfrac, tauc, &
+                      ciwp, clwp, rei, rel, ncbands, taucloud)
+
+! Calculate information needed by the radiative transfer routine
+! that is specific to this atmosphere, especially some of the 
+! coefficients and indices needed to compute the optical depths
+! by interpolating data from stored reference atmospheres. 
+
+         call setcoef(nlayers, istart, pavel, tavel, tz, tbound, semiss, &
+                      coldry, wkl, wbrodl, &
+                      laytrop, jp, jt, jt1, planklay, planklev, plankbnd, &
+                      idrv, dplankbnd_dt, &
+                      colh2o, colco2, colo3, coln2o, colco, colch4, colo2, &
+                      colbrd, fac00, fac01, fac10, fac11, &
+                      rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, &
+                      rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, &
+                      rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, &
+                      selffac, selffrac, indself, forfac, forfrac, indfor, &
+                      minorfrac, scaleminor, scaleminorn2, indminor)
+
+!  Calculate the gaseous optical depths and Planck fractions for 
+!  each longwave spectral band.
+
+         call taumol(nlayers, pavel, wx, coldry, &
+                     laytrop, jp, jt, jt1, planklay, planklev, plankbnd, &
+                     colh2o, colco2, colo3, coln2o, colco, colch4, colo2, &
+                     colbrd, fac00, fac01, fac10, fac11, &
+                     rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, &
+                     rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, &
+                     rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, &
+                     selffac, selffrac, indself, forfac, forfrac, indfor, &
+                     minorfrac, scaleminor, scaleminorn2, indminor, &
+                     fracs, taug)
+
+! Combine gaseous and aerosol optical depths, if aerosol active
+         if (iaer .eq. 0) then
+            do k = 1, nlayers
+               do ig = 1, ngptlw
+                  taut(k,ig) = taug(k,ig)
+               enddo
+            enddo
+         elseif (iaer .eq. 10) then
+            do k = 1, nlayers
+               do ig = 1, ngptlw
+                  taut(k,ig) = taug(k,ig) + taua(k,ngb(ig))
+               enddo
+            enddo
+         endif
+
+! Call the radiative transfer routine.
+! Either routine can be called to do clear sky calculation.  If clouds
+! are present, then select routine based on cloud overlap assumption
+! to be used.  Clear sky calculation is done simultaneously.
+
+        if (icld .eq. 1) then
+           call rtrn(nlayers, istart, iend, iout, pz, semiss, ncbands, &
+                  cldfrac, taucloud, planklay, planklev, plankbnd, &
+                  pwvcm, fracs, taut, &
+                  totuflux, totdflux, fnet, htr, &
+                  totuclfl, totdclfl, fnetc, htrc, &
+                  idrv, dplankbnd_dt, dtotuflux_dt, dtotuclfl_dt )
+        else
+           call rtrnmr(nlayers, istart, iend, iout, pz, semiss, ncbands, &
+                  cldfrac, taucloud, planklay, planklev, plankbnd, &
+                  pwvcm, fracs, taut, &
+                  totuflux, totdflux, fnet, htr, &
+                  totuclfl, totdclfl, fnetc, htrc, &
+                  idrv, dplankbnd_dt, dtotuflux_dt, dtotuclfl_dt )
+        endif
+
+!  Transfer up and down fluxes and heating rate to output arrays.
+!  Vertical indexing goes from bottom to top; reverse here for GCM if necessary.
+
+           do k = 0, nlayers
+              uflx(iplon,k+1) = totuflux(k)
+              dflx(iplon,k+1) = totdflux(k)
+              uflxc(iplon,k+1) = totuclfl(k)
+              dflxc(iplon,k+1) = totdclfl(k)
+           enddo
+           do k = 0, nlayers-1
+              hr(iplon,k+1) = htr(k)
+              hrc(iplon,k+1) = htrc(k)
+           enddo
+
+!  If idrv=1 option is active, transfer upward flux derivatives to output arrays.
+
+         if (idrv .eq. 1) then 
+            do k = 0, nlayers
+               duflx_dt(iplon,k+1) = dtotuflux_dt(k)
+               duflxc_dt(iplon,k+1) = dtotuclfl_dt(k)
+            enddo
+         endif
+
+! End longitude/column loop
+      enddo
+
+      end subroutine rrtmg_lw
+
+!***************************************************************************
+      subroutine inatm (iplon, nlay, icld, iaer, &
+              play, plev, tlay, tlev, tsfc, h2ovmr, &
+              o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, cfc11vmr, cfc12vmr, &
+              cfc22vmr, ccl4vmr, emis, inflglw, iceflglw, liqflglw, &
+              cldfr, taucld, cicewp, cliqwp, reice, reliq, tauaer, &
+              nlayers, pavel, pz, tavel, tz, tbound, semiss, coldry, &
+              wkl, wbrodl, wx, pwvcm, inflag, iceflag, liqflag, &
+              cldfrac, tauc, ciwp, clwp, rei, rel, taua)
+!***************************************************************************
+!
+!  Input atmospheric profile from GCM, and prepare it for use in RRTMG_LW.
+!  Set other RRTMG_LW input parameters.  
+!
+!***************************************************************************
+
+! --------- Modules ----------
+
+      use parrrtm, only : nbndlw, ngptlw, nmol, maxxsec, mxmol
+      use rrlw_con, only: fluxfac, heatfac, oneminus, pi, grav, avogad
+      use rrlw_wvn, only: ng, nspa, nspb, wavenum1, wavenum2, delwave, ixindx
+
+! ------- Declarations -------
+
+! ----- Input -----
+! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
+! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol) 
+      integer(kind=im), intent(in) :: iplon           ! column loop index
+      integer(kind=im), intent(in) :: nlay            ! Number of model layers
+      integer(kind=im), intent(in) :: icld            ! clear/cloud and cloud overlap flag
+      integer(kind=im), intent(in) :: iaer            ! aerosol option flag
+
+      real(kind=rb), intent(in) :: play(:,:)          ! Layer pressures (hPa, mb)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: plev(:,:)          ! Interface pressures (hPa, mb)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tlay(:,:)          ! Layer temperatures (K)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: tlev(:,:)          ! Interface temperatures (K)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tsfc(:)            ! Surface temperature (K)
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: h2ovmr(:,:)        ! H2O volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o3vmr(:,:)         ! O3 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: co2vmr(:,:)        ! CO2 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: ch4vmr(:,:)        ! Methane volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: n2ovmr(:,:)        ! Nitrous oxide volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o2vmr(:,:)         ! Oxygen volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cfc11vmr(:,:)      ! CFC11 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cfc12vmr(:,:)      ! CFC12 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cfc22vmr(:,:)      ! CFC22 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: ccl4vmr(:,:)       ! CCL4 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: emis(:,:)          ! Surface emissivity
+                                                      !    Dimensions: (ncol,nbndlw)
+
+      integer(kind=im), intent(in) :: inflglw         ! Flag for cloud optical properties
+      integer(kind=im), intent(in) :: iceflglw        ! Flag for ice particle specification
+      integer(kind=im), intent(in) :: liqflglw        ! Flag for liquid droplet specification
+
+      real(kind=rb), intent(in) :: cldfr(:,:)         ! Cloud fraction
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cicewp(:,:)        ! Cloud ice water path (g/m2)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cliqwp(:,:)        ! Cloud liquid water path (g/m2)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: reice(:,:)         ! Cloud ice effective size (microns)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: reliq(:,:)         ! Cloud water drop effective radius (microns)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: taucld(:,:,:)      ! In-cloud optical depth
+                                                      !    Dimensions: (nbndlw,ncol,nlay)
+      real(kind=rb), intent(in) :: tauaer(:,:,:)      ! Aerosol optical depth
+                                                      !    Dimensions: (ncol,nlay,nbndlw)
+
+! ----- Output -----
+! Atmosphere
+      integer(kind=im), intent(out) :: nlayers        ! number of layers
+
+      real(kind=rb), intent(out) :: pavel(:)          ! layer pressures (mb) 
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: tavel(:)          ! layer temperatures (K)
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: pz(0:)            ! level (interface) pressures (hPa, mb)
+                                                      !    Dimensions: (0:nlay)
+      real(kind=rb), intent(out) :: tz(0:)            ! level (interface) temperatures (K)
+                                                      !    Dimensions: (0:nlay)
+      real(kind=rb), intent(out) :: tbound            ! surface temperature (K)
+      real(kind=rb), intent(out) :: coldry(:)         ! dry air column density (mol/cm2)
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: wbrodl(:)         ! broadening gas column density (mol/cm2)
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: wkl(:,:)          ! molecular amounts (mol/cm-2)
+                                                      !    Dimensions: (mxmol,nlay)
+      real(kind=rb), intent(out) :: wx(:,:)           ! cross-section amounts (mol/cm-2)
+                                                      !    Dimensions: (maxxsec,nlay)
+      real(kind=rb), intent(out) :: pwvcm             ! precipitable water vapor (cm)
+      real(kind=rb), intent(out) :: semiss(:)         ! lw surface emissivity
+                                                      !    Dimensions: (nbndlw)
+
+! Atmosphere/clouds - cldprop
+      integer(kind=im), intent(out) :: inflag         ! flag for cloud property method
+      integer(kind=im), intent(out) :: iceflag        ! flag for ice cloud properties
+      integer(kind=im), intent(out) :: liqflag        ! flag for liquid cloud properties
+
+      real(kind=rb), intent(out) :: cldfrac(:)        ! layer cloud fraction
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: ciwp(:)           ! cloud ice water path
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: clwp(:)           ! cloud liquid water path
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: rel(:)            ! cloud liquid particle effective radius (microns)
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: rei(:)            ! cloud ice particle effective size (microns)
+                                                      !    Dimensions: (nlay)
+      real(kind=rb), intent(out) :: tauc(:,:)         ! in-cloud optical depth
+                                                      !    Dimensions: (nbndlw,nlay)
+      real(kind=rb), intent(out) :: taua(:,:)         ! aerosol optical depth
+                                                      !    Dimensions: (nlay,nbndlw)
+
+
+! ----- Local -----
+      real(kind=rb), parameter :: amd = 28.9660_rb    ! Effective molecular weight of dry air (g/mol)
+      real(kind=rb), parameter :: amw = 18.0160_rb    ! Molecular weight of water vapor (g/mol)
+!      real(kind=rb), parameter :: amc = 44.0098_rb    ! Molecular weight of carbon dioxide (g/mol)
+!      real(kind=rb), parameter :: amo = 47.9998_rb    ! Molecular weight of ozone (g/mol)
+!      real(kind=rb), parameter :: amo2 = 31.9999_rb   ! Molecular weight of oxygen (g/mol)
+!      real(kind=rb), parameter :: amch4 = 16.0430_rb  ! Molecular weight of methane (g/mol)
+!      real(kind=rb), parameter :: amn2o = 44.0128_rb  ! Molecular weight of nitrous oxide (g/mol)
+!      real(kind=rb), parameter :: amc11 = 137.3684_rb ! Molecular weight of CFC11 (g/mol) - CCL3F
+!      real(kind=rb), parameter :: amc12 = 120.9138_rb ! Molecular weight of CFC12 (g/mol) - CCL2F2
+!      real(kind=rb), parameter :: amc22 = 86.4688_rb  ! Molecular weight of CFC22 (g/mol) - CHCLF2
+!      real(kind=rb), parameter :: amcl4 = 153.823_rb  ! Molecular weight of CCL4 (g/mol) - CCL4
+
+! Set molecular weight ratios (for converting mmr to vmr)
+!  e.g. h2ovmr = h2ommr * amdw)
+      real(kind=rb), parameter :: amdw = 1.607793_rb  ! Molecular weight of dry air / water vapor
+      real(kind=rb), parameter :: amdc = 0.658114_rb  ! Molecular weight of dry air / carbon dioxide
+      real(kind=rb), parameter :: amdo = 0.603428_rb  ! Molecular weight of dry air / ozone
+      real(kind=rb), parameter :: amdm = 1.805423_rb  ! Molecular weight of dry air / methane
+      real(kind=rb), parameter :: amdn = 0.658090_rb  ! Molecular weight of dry air / nitrous oxide
+      real(kind=rb), parameter :: amdo2 = 0.905140_rb ! Molecular weight of dry air / oxygen
+      real(kind=rb), parameter :: amdc1 = 0.210852_rb ! Molecular weight of dry air / CFC11
+      real(kind=rb), parameter :: amdc2 = 0.239546_rb ! Molecular weight of dry air / CFC12
+
+      integer(kind=im) :: isp, l, ix, n, imol, ib       ! Loop indices
+      real(kind=rb) :: amm, amttl, wvttl, wvsh, summol  
+
+! Add one to nlayers here to include extra model layer at top of atmosphere
+      nlayers = nlay
+
+!  Initialize all molecular amounts and cloud properties to zero here, then pass input amounts
+!  into RRTM arrays below.
+
+      wkl(:,:) = 0.0_rb
+      wx(:,:) = 0.0_rb
+      cldfrac(:) = 0.0_rb
+      tauc(:,:) = 0.0_rb
+      ciwp(:) = 0.0_rb
+      clwp(:) = 0.0_rb
+      rei(:) = 0.0_rb
+      rel(:) = 0.0_rb
+      taua(:,:) = 0.0_rb
+      amttl = 0.0_rb
+      wvttl = 0.0_rb
+ 
+!  Set surface temperature.
+      tbound = tsfc(iplon)
+
+!  Install input GCM arrays into RRTMG_LW arrays for pressure, temperature,
+!  and molecular amounts.  
+!  Pressures are input in mb, or are converted to mb here.
+!  Molecular amounts are input in volume mixing ratio, or are converted from 
+!  mass mixing ratio (or specific humidity for h2o) to volume mixing ratio
+!  here. These are then converted to molecular amount (molec/cm2) below.  
+!  The dry air column COLDRY (in molec/cm2) is calculated from the level 
+!  pressures, pz (in mb), based on the hydrostatic equation and includes a 
+!  correction to account for h2o in the layer.  The molecular weight of moist 
+!  air (amm) is calculated for each layer.  
+!  Note: In RRTMG, layer indexing goes from bottom to top, and coding below
+!  assumes GCM input fields are also bottom to top. Input layer indexing
+!  from GCM fields should be reversed here if necessary.
+
+      pz(0) = plev(iplon,1)
+      tz(0) = tlev(iplon,1)
+      do l = 1, nlayers
+         pavel(l) = play(iplon,l)
+         tavel(l) = tlay(iplon,l)
+         pz(l) = plev(iplon,l+1)
+         tz(l) = tlev(iplon,l+1)
+! For h2o input in vmr:
+         wkl(1,l) = h2ovmr(iplon,l)
+! For h2o input in mmr:
+!         wkl(1,l) = h2o(iplon,l)*amdw
+! For h2o input in specific humidity;
+!         wkl(1,l) = (h2o(iplon,l)/(1._rb - h2o(iplon,l)))*amdw
+         wkl(2,l) = co2vmr(iplon,l)
+         wkl(3,l) = o3vmr(iplon,l)
+         wkl(4,l) = n2ovmr(iplon,l)
+         wkl(6,l) = ch4vmr(iplon,l)
+         wkl(7,l) = o2vmr(iplon,l)
+         amm = (1._rb - wkl(1,l)) * amd + wkl(1,l) * amw            
+         coldry(l) = (pz(l-1)-pz(l)) * 1.e3_rb * avogad / &
+                     (1.e2_rb * grav * amm * (1._rb + wkl(1,l)))
+      enddo
+
+! Set cross section molecule amounts from input; convert to vmr if necessary
+      do l=1, nlayers
+         wx(1,l) = ccl4vmr(iplon,l)
+         wx(2,l) = cfc11vmr(iplon,l)
+         wx(3,l) = cfc12vmr(iplon,l)
+         wx(4,l) = cfc22vmr(iplon,l)
+      enddo      
+
+! The following section can be used to set values for an additional layer (from
+! the GCM top level to 1.e-4 mb) for improved calculation of TOA fluxes. 
+! Temperature and molecular amounts in the extra model layer are set to 
+! their values in the top GCM model layer, though these can be modified
+! here if necessary. 
+! If this feature is utilized, increase nlayers by one above, limit the two
+! loops above to (nlayers-1), and set the top most (extra) layer values here. 
+
+!      pavel(nlayers) = 0.5_rb * pz(nlayers-1)
+!      tavel(nlayers) = tavel(nlayers-1)
+!      pz(nlayers) = 1.e-4_rb
+!      tz(nlayers-1) = 0.5_rb * (tavel(nlayers)+tavel(nlayers-1))
+!      tz(nlayers) = tz(nlayers-1)
+!      wkl(1,nlayers) = wkl(1,nlayers-1)
+!      wkl(2,nlayers) = wkl(2,nlayers-1)
+!      wkl(3,nlayers) = wkl(3,nlayers-1)
+!      wkl(4,nlayers) = wkl(4,nlayers-1)
+!      wkl(6,nlayers) = wkl(6,nlayers-1)
+!      wkl(7,nlayers) = wkl(7,nlayers-1)
+!      amm = (1._rb - wkl(1,nlayers-1)) * amd + wkl(1,nlayers-1) * amw
+!      coldry(nlayers) = (pz(nlayers-1)) * 1.e3_rb * avogad / &
+!                        (1.e2_rb * grav * amm * (1._rb + wkl(1,nlayers-1)))
+!      wx(1,nlayers) = wx(1,nlayers-1)
+!      wx(2,nlayers) = wx(2,nlayers-1)
+!      wx(3,nlayers) = wx(3,nlayers-1)
+!      wx(4,nlayers) = wx(4,nlayers-1)
+
+! At this point all moleculular amounts in wkl and wx are in volume mixing ratio; 
+! convert to molec/cm2 based on coldry for use in rrtm.  also, compute precipitable
+! water vapor for diffusivity angle adjustments in rtrn and rtrnmr.
+
+      do l = 1, nlayers
+         summol = 0.0_rb
+         do imol = 2, nmol
+            summol = summol + wkl(imol,l)
+         enddo
+         wbrodl(l) = coldry(l) * (1._rb - summol)
+         do imol = 1, nmol
+            wkl(imol,l) = coldry(l) * wkl(imol,l)
+         enddo
+         amttl = amttl + coldry(l)+wkl(1,l)
+         wvttl = wvttl + wkl(1,l)
+         do ix = 1,maxxsec
+            if (ixindx(ix) .ne. 0) then
+               wx(ixindx(ix),l) = coldry(l) * wx(ix,l) * 1.e-20_rb
+            endif
+         enddo
+      enddo
+
+      wvsh = (amw * wvttl) / (amd * amttl)
+      pwvcm = wvsh * (1.e3_rb * pz(0)) / (1.e2_rb * grav)
+
+! Set spectral surface emissivity for each longwave band.  
+
+      do n=1,nbndlw
+         semiss(n) = emis(iplon,n)
+!          semiss(n) = 1.0_rb
+      enddo
+
+! Transfer aerosol optical properties to RRTM variable;
+! modify to reverse layer indexing here if necessary.
+
+     if (iaer .ge. 1) then
+        do l = 1, nlayers
+           do ib = 1, nbndlw
+              taua(l,ib) = tauaer(iplon,l,ib)
+           enddo
+        enddo
+      endif
+
+! Transfer cloud fraction and cloud optical properties to RRTM variables,
+! modify to reverse layer indexing here if necessary.
+
+      if (icld .ge. 1) then 
+         inflag = inflglw
+         iceflag = iceflglw
+         liqflag = liqflglw
+
+! Move incoming GCM cloud arrays to RRTMG cloud arrays.
+! For GCM input, incoming reice is defined based on selected ice parameterization (inflglw)
+
+         do l = 1, nlayers
+            cldfrac(l) = cldfr(iplon,l)
+            ciwp(l) = cicewp(iplon,l)
+            clwp(l) = cliqwp(iplon,l)
+            rei(l) = reice(iplon,l)
+            rel(l) = reliq(iplon,l)
+            do n=1,nbndlw
+               tauc(n,l) = taucld(n,iplon,l)
+!               ssac(n,l) = ssacld(n,iplon,l)
+!               asmc(n,l) = asmcld(n,iplon,l)
+            enddo
+         enddo
+
+! If an extra layer is being used in RRTMG, set all cloud properties to zero in the extra layer.
+
+!         cldfrac(nlayers) = 0.0_rb
+!         tauc(:nbndlw,nlayers) = 0.0_rb
+!         ciwp(nlayers) = 0.0_rb
+!         clwp(nlayers) = 0.0_rb
+!         rei(nlayers) = 0.0_rb
+!         rel(nlayers) = 0.0_rb
+!         taua(nlayers,:) = 0.0_rb
+
+      endif
+      
+      end subroutine inatm
+
+      end module rrtmg_lw_rad
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_read_nc.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_read_nc.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_read_nc.f90	(revision 1585)
@@ -0,0 +1,1032 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_read_nc.f90,v $
+!     author:    $Author: mike $
+!     revision:  $Revision: 1.1 $
+!     created:   $Date: 2009/05/22 21:02:13 $
+!
+
+!=============================================================================== 
+! rrtmg_lw_read_nc.f90
+!
+! Description: This program reads all of the RRTM longwave data from a NetCDF
+!              file in band by band subroutines, as a replacement for the 
+!              rrtmg_lw_k_g.f90 data statements.
+!
+! Written By: Patrick Hofmann
+! Last Update: 1/23/2009
+!===============================================================================
+
+!*******************************************************************************
+subroutine lw_kgb01
+	use rrlw_kg01, only : fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, &
+						selfrefo, forrefo, no1
+	use rrlw_ncpar
+	use netcdf
+	
+	implicit none
+	save 
+	
+	integer(kind=im) :: ab
+	integer(kind=im), parameter :: bandNumber = 1, numGPoints = no1
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for N2
+	call getAbsorberIndex('N2',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mn2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, kbo_mn2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb01
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb02
+        use rrlw_kg02, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, no2
+        use rrlw_ncpar
+	use netcdf
+    
+        implicit none
+        save
+		
+   	integer(kind=im), parameter :: bandNumber = 2
+	integer(kind=im), parameter :: numGPoints = no2
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb02
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb03
+        use rrlw_kg03, only : fracrefao, fracrefbo, kao, kbo, kao_mn2o, &
+                          kbo_mn2o, selfrefo, forrefo, no3
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+	integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 3
+	integer(kind=im), parameter :: numGPoints = no3
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keylower,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keyupper,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keyupper,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for N2
+	call getAbsorberIndex('N2O',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mn2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,T,numGPoints,1,1,1/))
+	
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, kbo_mn2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/keyupper,T,numGPoints,1,1,1/))
+
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb03
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb04
+        use rrlw_kg04, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, no4
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+		
+        integer(kind=im), parameter :: bandNumber = 4
+	integer(kind=im), parameter :: numGPoints = no4
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keylower,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo(:,1:5), &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keyupper,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keyupper,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb04
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb05
+        use rrlw_kg05, only : fracrefao, fracrefbo, kao, kbo, kao_mo3, &
+                          selfrefo, forrefo, ccl4o, no5
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    
+        integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 5
+	integer(kind=im), parameter :: numGPoints = no5
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keylower,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keyupper,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, & 
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keyupper,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for O3
+	call getAbsorberIndex('O3',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mo3, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for CCL4
+	call getAbsorberIndex('CCL4',ab)
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, ccl4o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb05
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb06
+        use rrlw_kg06, only : fracrefao, kao, kao_mco2, selfrefo, forrefo, &
+                          cfc11adjo, cfc12o, no6
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+	integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 6
+	integer(kind=im), parameter :: numGPoints = no6
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(9)   = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+
+	!Get absorber index for CO2
+	call getAbsorberIndex('CO2',ab)
+	status(12)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(13)  = nf90_get_var(ncid, varID, kao_mco2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for CFC11
+	call getAbsorberIndex('CFC11',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, cfc11adjo, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+	
+	!Get absorber index for CFC12
+	call getAbsorberIndex('CFC12',ab)
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, cfc12o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb06
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb07	
+        use rrlw_kg07, only : fracrefao, fracrefbo, kao, kbo, kao_mco2, &
+                          kbo_mco2, selfrefo, forrefo, no7
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+        integer(kind=im) :: ab
+   	integer(kind=im), parameter :: bandNumber = 7
+	integer(kind=im), parameter :: numGPoints = no7
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keylower,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, & 
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for CO2
+	call getAbsorberIndex('CO2',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mco2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,T,numGPoints,1,1,1/))
+	
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, kbo_mco2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb07
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb08		
+        use rrlw_kg08, only : fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, &
+                          kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, &
+                          cfc12o, cfc22adjo, no8
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+        integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 8
+	integer(kind=im), parameter :: numGPoints = no8
+        integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+        status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for O3
+	call getAbsorberIndex('O3',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mo3, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for CO2
+	call getAbsorberIndex('CO2',ab)
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, kao_mco2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	status(18)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(19)  = nf90_get_var(ncid, varID, kbo_mco2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for N2O
+	call getAbsorberIndex('N2O',ab)
+	status(20)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(21)  = nf90_get_var(ncid, varID, kao_mn2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	status(22)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(23)  = nf90_get_var(ncid, varID, kbo_mn2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for CFC12
+	call getAbsorberIndex('CFC12',ab)
+	status(24)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(25)  = nf90_get_var(ncid, varID, cfc12o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+	
+	!Get absorber index for CFC22
+	call getAbsorberIndex('CFC22',ab)
+	status(26)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(27)  = nf90_get_var(ncid, varID, cfc22adjo, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb08
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb09	
+        use rrlw_kg09, only : fracrefao, fracrefbo, kao, kbo, kao_mn2o, &
+                            kbo_mn2o, selfrefo, forrefo, no9
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+        integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 9
+	integer(kind=im), parameter :: numGPoints = no9
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,keylower,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+
+	!Get absorber index for N2O
+	call getAbsorberIndex('N2O',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mn2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/keylower,T,numGPoints,1,1,1/))
+	
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, kbo_mn2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb09
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb10		
+        use rrlw_kg10, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, no10
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+   	integer(kind=im), parameter :: bandNumber = 10
+	integer(kind=im), parameter :: numGPoints = no10
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb10
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb11
+        use rrlw_kg11, only : fracrefao, fracrefbo, kao, kbo, kao_mo2, &
+                          kbo_mo2, selfrefo, forrefo, no11
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+	integer(kind=im) :: ab
+	integer(kind=im), parameter :: bandNumber = 11
+	integer(kind=im), parameter :: numGPoints = no11
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)   = nf90_NoErr
+	status(1)   = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)   = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)   = nf90_get_var(ncid, varID, fracrefao, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(4)   = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)   = nf90_get_var(ncid, varID, fracrefbo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/numGPoints,1,1,1/))
+	
+	status(6)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)   = nf90_get_var(ncid, varID, kao, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)   = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)   = nf90_get_var(ncid, varID, kbo, &
+                      start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                      count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11)  = nf90_get_var(ncid, varID, selfrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tself,numGPoints,1,1/))
+	
+	status(12)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13)  = nf90_get_var(ncid, varID, forrefo, &
+                      start = (/1,1,bandNumber,gPointSetNumber/), &
+                      count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for O2
+	call getAbsorberIndex('O2',ab)
+	status(14)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15)  = nf90_get_var(ncid, varID, kao_mo2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, kbo_mo2, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,T,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb11
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb12
+        use rrlw_kg12, only : fracrefao, kao, selfrefo, forrefo, no12
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+		
+	integer(kind=im), parameter :: bandNumber = 12
+	integer(kind=im), parameter :: numGPoints = no12
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:) = nf90_NoErr
+	status(1) = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2) = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3) = nf90_get_var(ncid, varID, fracrefao, &
+                    start = (/1,1,bandNumber,gPointSetNumber/), &
+                    count = (/numGPoints,keylower,1,1/))
+	
+	status(4) = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(5) = nf90_get_var(ncid, varID, kao, &
+                    start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                    count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(6) = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(7) = nf90_get_var(ncid, varID, selfrefo, &
+                    start = (/1,1,bandNumber,gPointSetNumber/), &
+                    count = (/Tself,numGPoints,1,1/))
+	
+	status(8) = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(9) = nf90_get_var(ncid, varID, forrefo, &
+                    start = (/1,1,bandNumber,gPointSetNumber/), &
+                    count = (/Tforeign,numGPoints,1,1/))
+
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb12
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb13		
+        use rrlw_kg13, only : fracrefao, fracrefbo, kao, kao_mco2, kao_mco, &
+                          kbo_mo3, selfrefo, forrefo, no13
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    
+        integer(kind=im) :: ab
+	integer(kind=im), parameter :: bandNumber = 13
+	integer(kind=im), parameter :: numGPoints = no13  
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, fracrefao, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, fracrefbo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/),  &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(9)  = nf90_get_var(ncid, varID, selfrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, forrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for O3
+	call getAbsorberIndex('O3',ab)
+	status(12) = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, kbo_mo3, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/1,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for CO2
+	call getAbsorberIndex('CO2',ab)
+	status(14) = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(15) = nf90_get_var(ncid, varID, kao_mco2, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,T,numGPoints,1,1,1/))
+	
+	!Get absorber index for CO
+	call getAbsorberIndex('CO',ab)
+	status(16) = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+        status(17) = nf90_get_var(ncid, varID, kao_mco, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,T,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb13
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb14	
+        use rrlw_kg14, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, no14
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+	integer(kind=im), parameter :: bandNumber = 14
+	integer(kind=im), parameter :: numGPoints = no14
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, fracrefao, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, fracrefbo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeign,numGPoints,1,1/))
+
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb14
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb15	
+        use rrlw_kg15, only : fracrefao, kao, kao_mn2, selfrefo, forrefo, no15
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    
+        integer(kind=im) :: ab
+ 	integer(kind=im), parameter :: bandNumber = 15
+	integer(kind=im), parameter :: numGPoints = no15
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, fracrefao, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(6)  = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(7)  = nf90_get_var(ncid, varID, selfrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(9)  = nf90_get_var(ncid, varID, forrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeign,numGPoints,1,1/))
+	
+	!Get absorber index for N2
+	call getAbsorberIndex('N2',ab)
+	status(10) = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(11) = nf90_get_var(ncid, varID, kao_mn2, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,T,numGPoints,1,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb15
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine lw_kgb16		
+        use rrlw_kg16, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo, no16
+	use rrlw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	  
+        integer(kind=im), parameter :: bandNumber = 16
+ 	integer(kind=im), parameter :: numGPoints = no16
+        integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+        status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_lw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"PlanckFractionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, fracrefao, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"PlanckFractionUpperAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, fracrefbo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H20SelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H20ForeignAbsorptionCoefficients",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeign,numGPoints,1,1/))
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading variables from file" 
+	
+	status(1) = nf90_close(ncid)
+	
+end subroutine lw_kgb16
+!*******************************************************************************
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrn.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrn.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrn.f90	(revision 1585)
@@ -0,0 +1,590 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_rtrn.f90,v $
+!     author:    $Author: mike $
+!     revision:  $Revision: 1.7 $
+!     created:   $Date: 2009/11/12 20:52:25 $
+!
+      module rrtmg_lw_rtrn
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! --------- Modules ----------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : mg, nbndlw, ngptlw
+      use rrlw_con, only: fluxfac, heatfac
+      use rrlw_wvn, only: delwave, ngs
+      use rrlw_tbl, only: tblint, bpade, tau_tbl, exp_tbl, tfn_tbl
+      use rrlw_vsn, only: hvrrtr, hnamrtr
+
+      implicit none
+
+      contains
+
+!-----------------------------------------------------------------------------
+      subroutine rtrn(nlayers, istart, iend, iout, pz, semiss, ncbands, &
+                      cldfrac, taucloud, planklay, planklev, plankbnd, &
+                      pwvcm, fracs, taut, & 
+                      totuflux, totdflux, fnet, htr, &
+                      totuclfl, totdclfl, fnetc, htrc, &
+                      idrv, dplankbnd_dt, dtotuflux_dt, dtotuclfl_dt )
+!-----------------------------------------------------------------------------
+!
+!  Original version:   E. J. Mlawer, et al. RRTM_V3.0
+!  Revision for GCMs:  Michael J. Iacono; October, 2002
+!  Revision for F90:  Michael J. Iacono; June, 2006
+!  Revision for dFdT option: M. J. Iacono and E. J. Mlawer, November 2009
+!
+!  This program calculates the upward fluxes, downward fluxes, and
+!  heating rates for an arbitrary clear or cloudy atmosphere.  The input
+!  to this program is the atmospheric profile, all Planck function
+!  information, and the cloud fraction by layer.  A variable diffusivity 
+!  angle (SECDIFF) is used for the angle integration.  Bands 2-3 and 5-9 
+!  use a value for SECDIFF that varies from 1.50 to 1.80 as a function of 
+!  the column water vapor, and other bands use a value of 1.66.  The Gaussian 
+!  weight appropriate to this angle (WTDIFF=0.5) is applied here.  Note that 
+!  use of the emissivity angle for the flux integration can cause errors of 
+!  1 to 4 W/m2 within cloudy layers.  
+!  Clouds are treated with a random cloud overlap method.
+!  This subroutine also provides the optional capability to calculate
+!  the derivative of upward flux respect to surface temperature using
+!  the pre-tabulated derivative of the Planck function with respect to 
+!  temperature integrated over each spectral band.
+!***************************************************************************
+
+! ------- Declarations -------
+
+! ----- Input -----
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: istart          ! beginning band of calculation
+      integer(kind=im), intent(in) :: iend            ! ending band of calculation
+      integer(kind=im), intent(in) :: iout            ! output option flag
+
+! Atmosphere
+      real(kind=rb), intent(in) :: pz(0:)             ! level (interface) pressures (hPa, mb)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: pwvcm              ! precipitable water vapor (cm)
+      real(kind=rb), intent(in) :: semiss(:)          ! lw surface emissivity
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(in) :: planklay(:,:)      ! 
+                                                      !    Dimensions: (nlayers,nbndlw)
+      real(kind=rb), intent(in) :: planklev(0:,:)     ! 
+                                                      !    Dimensions: (0:nlayers,nbndlw)
+      real(kind=rb), intent(in) :: plankbnd(:)        ! 
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(in) :: fracs(:,:)         ! 
+                                                      !    Dimensions: (nlayers,ngptw)
+      real(kind=rb), intent(in) :: taut(:,:)          ! gaseous + aerosol optical depths
+                                                      !    Dimensions: (nlayers,ngptlw)
+
+! Clouds
+      integer(kind=im), intent(in) :: ncbands         ! number of cloud spectral bands
+      real(kind=rb), intent(in) :: cldfrac(:)         ! layer cloud fraction
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: taucloud(:,:)      ! layer cloud optical depth
+                                                      !    Dimensions: (nlayers,nbndlw)
+      integer(kind=im), intent(in) :: idrv            ! flag for calculation of dF/dt from 
+                                                      ! Planck derivative [0=off, 1=on]
+      real(kind=rb), intent(in) :: dplankbnd_dt(:)    ! derivative of Planck function wrt temp
+                                                      !    Dimensions: (nbndlw)
+
+! ----- Output -----
+      real(kind=rb), intent(out) :: totuflux(0:)      ! upward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totdflux(0:)      ! downward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: fnet(0:)          ! net longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: htr(0:)           ! longwave heating rate (k/day)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totuclfl(0:)      ! clear sky upward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totdclfl(0:)      ! clear sky downward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: fnetc(0:)         ! clear sky net longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: htrc(0:)          ! clear sky longwave heating rate (k/day)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: dtotuflux_dt(0:)  ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: dtotuclfl_dt(0:)  ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (0:nlayers)
+
+! ----- Local -----
+! Declarations for radiative transfer
+      real(kind=rb) :: abscld(nlayers,nbndlw)
+      real(kind=rb) :: atot(nlayers)
+      real(kind=rb) :: atrans(nlayers)
+      real(kind=rb) :: bbugas(nlayers)
+      real(kind=rb) :: bbutot(nlayers)
+      real(kind=rb) :: clrurad(0:nlayers)
+      real(kind=rb) :: clrdrad(0:nlayers)
+      real(kind=rb) :: efclfrac(nlayers,nbndlw)
+      real(kind=rb) :: uflux(0:nlayers)
+      real(kind=rb) :: dflux(0:nlayers)
+      real(kind=rb) :: urad(0:nlayers)
+      real(kind=rb) :: drad(0:nlayers)
+      real(kind=rb) :: uclfl(0:nlayers)
+      real(kind=rb) :: dclfl(0:nlayers)
+      real(kind=rb) :: odcld(nlayers,nbndlw)
+
+
+      real(kind=rb) :: secdiff(nbndlw)                 ! secant of diffusivity angle
+      real(kind=rb) :: a0(nbndlw),a1(nbndlw),a2(nbndlw)! diffusivity angle adjustment coefficients
+      real(kind=rb) :: wtdiff, rec_6
+      real(kind=rb) :: transcld, radld, radclrd, plfrac, blay, dplankup, dplankdn
+      real(kind=rb) :: odepth, odtot, odepth_rec, odtot_rec, gassrc
+      real(kind=rb) :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, tausfac
+      real(kind=rb) :: rad0, reflect, radlu, radclru
+
+      real(kind=rb) :: duflux_dt(0:nlayers)
+      real(kind=rb) :: duclfl_dt(0:nlayers)
+      real(kind=rb) :: d_urad_dt(0:nlayers)
+      real(kind=rb) :: d_clrurad_dt(0:nlayers)
+      real(kind=rb) :: d_rad0_dt, d_radlu_dt, d_radclru_dt
+
+      integer(kind=im) :: icldlyr(nlayers)             ! flag for cloud in layer
+      integer(kind=im) :: ibnd, ib, iband, lay, lev, l ! loop indices
+      integer(kind=im) :: igc                          ! g-point interval counter
+      integer(kind=im) :: iclddn                       ! flag for cloud in down path
+      integer(kind=im) :: ittot, itgas, itr            ! lookup table indices
+      integer(kind=im) :: ipat(16,0:2)
+
+
+! ------- Definitions -------
+! input
+!    nlayers                      ! number of model layers
+!    ngptlw                       ! total number of g-point subintervals
+!    nbndlw                       ! number of longwave spectral bands
+!    ncbands                      ! number of spectral bands for clouds
+!    secdiff                      ! diffusivity angle
+!    wtdiff                       ! weight for radiance to flux conversion
+!    pavel                        ! layer pressures (mb)
+!    pz                           ! level (interface) pressures (mb)
+!    tavel                        ! layer temperatures (k)
+!    tz                           ! level (interface) temperatures(mb)
+!    tbound                       ! surface temperature (k)
+!    cldfrac                      ! layer cloud fraction
+!    taucloud                     ! layer cloud optical depth
+!    itr                          ! integer look-up table index
+!    icldlyr                      ! flag for cloudy layers
+!    iclddn                       ! flag for cloud in column at any layer
+!    semiss                       ! surface emissivities for each band
+!    reflect                      ! surface reflectance
+!    bpade                        ! 1/(pade constant)
+!    tau_tbl                      ! clear sky optical depth look-up table
+!    exp_tbl                      ! exponential look-up table for transmittance
+!    tfn_tbl                      ! tau transition function look-up table
+
+! local
+!    atrans                       ! gaseous absorptivity
+!    abscld                       ! cloud absorptivity
+!    atot                         ! combined gaseous and cloud absorptivity
+!    odclr                        ! clear sky (gaseous) optical depth
+!    odcld                        ! cloud optical depth
+!    odtot                        ! optical depth of gas and cloud
+!    tfacgas                      ! gas-only pade factor, used for planck fn
+!    tfactot                      ! gas and cloud pade factor, used for planck fn
+!    bbdgas                       ! gas-only planck function for downward rt
+!    bbugas                       ! gas-only planck function for upward rt
+!    bbdtot                       ! gas and cloud planck function for downward rt
+!    bbutot                       ! gas and cloud planck function for upward calc.
+!    gassrc                       ! source radiance due to gas only
+!    efclfrac                     ! effective cloud fraction
+!    radlu                        ! spectrally summed upward radiance 
+!    radclru                      ! spectrally summed clear sky upward radiance 
+!    urad                         ! upward radiance by layer
+!    clrurad                      ! clear sky upward radiance by layer
+!    radld                        ! spectrally summed downward radiance 
+!    radclrd                      ! spectrally summed clear sky downward radiance 
+!    drad                         ! downward radiance by layer
+!    clrdrad                      ! clear sky downward radiance by layer
+!    d_radlu_dt                   ! spectrally summed upward radiance 
+!    d_radclru_dt                 ! spectrally summed clear sky upward radiance 
+!    d_urad_dt                    ! upward radiance by layer
+!    d_clrurad_dt                 ! clear sky upward radiance by layer
+
+! output
+!    totuflux                     ! upward longwave flux (w/m2)
+!    totdflux                     ! downward longwave flux (w/m2)
+!    fnet                         ! net longwave flux (w/m2)
+!    htr                          ! longwave heating rate (k/day)
+!    totuclfl                     ! clear sky upward longwave flux (w/m2)
+!    totdclfl                     ! clear sky downward longwave flux (w/m2)
+!    fnetc                        ! clear sky net longwave flux (w/m2)
+!    htrc                         ! clear sky longwave heating rate (k/day)
+!    dtotuflux_dt                 ! change in upward longwave flux (w/m2/k)
+!                                 ! with respect to surface temperature
+!    dtotuclfl_dt                 ! change in clear sky upward longwave flux (w/m2/k)
+!                                 ! with respect to surface temperature
+
+! These arrays indicate the spectral 'region' (used in the 
+! calculation of ice cloud optical depths) corresponding
+! to each spectral band.  See cldprop.f for more details.
+      data ipat /1,1,1,1,1,1,1,1,1, 1, 1, 1, 1, 1, 1, 1, &
+                 1,2,3,3,3,4,4,4,5, 5, 5, 5, 5, 5, 5, 5, &
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/
+
+! This secant and weight corresponds to the standard diffusivity 
+! angle.  This initial value is redefined below for some bands.
+      data wtdiff /0.5_rb/
+      data rec_6 /0.166667_rb/
+
+! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
+! and 1.80) as a function of total column water vapor.  The function
+! has been defined to minimize flux and cooling rate errors in these bands
+! over a wide range of precipitable water values.
+      data a0 / 1.66_rb,  1.55_rb,  1.58_rb,  1.66_rb, &
+                1.54_rb, 1.454_rb,  1.89_rb,  1.33_rb, &
+               1.668_rb,  1.66_rb,  1.66_rb,  1.66_rb, &
+                1.66_rb,  1.66_rb,  1.66_rb,  1.66_rb /
+      data a1 / 0.00_rb,  0.25_rb,  0.22_rb,  0.00_rb, &
+                0.13_rb, 0.446_rb, -0.10_rb,  0.40_rb, &
+              -0.006_rb,  0.00_rb,  0.00_rb,  0.00_rb, &
+                0.00_rb,  0.00_rb,  0.00_rb,  0.00_rb /
+      data a2 / 0.00_rb, -12.0_rb, -11.7_rb,  0.00_rb, &
+               -0.72_rb,-0.243_rb,  0.19_rb,-0.062_rb, &
+               0.414_rb,  0.00_rb,  0.00_rb,  0.00_rb, &
+                0.00_rb,  0.00_rb,  0.00_rb,  0.00_rb /
+
+      hvrrtr = '$Revision: 1.7 $'
+
+      do ibnd = 1,nbndlw
+         if (ibnd.eq.1 .or. ibnd.eq.4 .or. ibnd.ge.10) then
+           secdiff(ibnd) = 1.66_rb
+         else
+           secdiff(ibnd) = a0(ibnd) + a1(ibnd)*exp(a2(ibnd)*pwvcm)
+           if (secdiff(ibnd) .gt. 1.80_rb) secdiff(ibnd) = 1.80_rb
+           if (secdiff(ibnd) .lt. 1.50_rb) secdiff(ibnd) = 1.50_rb
+         endif
+      enddo
+
+      urad(0) = 0.0_rb
+      drad(0) = 0.0_rb
+      totuflux(0) = 0.0_rb
+      totdflux(0) = 0.0_rb
+      clrurad(0) = 0.0_rb
+      clrdrad(0) = 0.0_rb
+      totuclfl(0) = 0.0_rb
+      totdclfl(0) = 0.0_rb
+      if (idrv .eq. 1) then
+         d_urad_dt(0) = 0.0_rb
+         d_clrurad_dt(0) = 0.0_rb
+         dtotuflux_dt(0) = 0.0_rb
+         dtotuclfl_dt(0) = 0.0_rb
+      endif
+
+      do lay = 1, nlayers
+         urad(lay) = 0.0_rb
+         drad(lay) = 0.0_rb
+         totuflux(lay) = 0.0_rb
+         totdflux(lay) = 0.0_rb
+         clrurad(lay) = 0.0_rb
+         clrdrad(lay) = 0.0_rb
+         totuclfl(lay) = 0.0_rb
+         totdclfl(lay) = 0.0_rb
+         if (idrv .eq. 1) then
+            d_urad_dt(lay) = 0.0_rb
+            d_clrurad_dt(lay) = 0.0_rb
+            dtotuflux_dt(lay) = 0.0_rb
+            dtotuclfl_dt(lay) = 0.0_rb
+         endif
+
+         do ib = 1, ncbands
+            if (cldfrac(lay) .ge. 1.e-6_rb) then
+               odcld(lay,ib) = secdiff(ib) * taucloud(lay,ib)
+               transcld = exp(-odcld(lay,ib))
+               abscld(lay,ib) = 1. - transcld
+               efclfrac(lay,ib) = abscld(lay,ib) * cldfrac(lay)
+               icldlyr(lay) = 1
+            else
+               odcld(lay,ib) = 0.0_rb
+               abscld(lay,ib) = 0.0_rb
+               efclfrac(lay,ib) = 0.0_rb
+               icldlyr(lay) = 0
+            endif
+         enddo
+      enddo
+
+      igc = 1
+! Loop over frequency bands.
+      do iband = istart, iend
+
+! Reinitialize g-point counter for each band if output for each band is requested.
+         if (iout.gt.0.and.iband.ge.2) igc = ngs(iband-1)+1
+         if (ncbands .eq. 1) then
+            ib = ipat(iband,0)
+         elseif (ncbands .eq.  5) then
+            ib = ipat(iband,1)
+         elseif (ncbands .eq. 16) then
+            ib = ipat(iband,2)
+         endif
+
+! Loop over g-channels.
+ 1000    continue
+
+! Radiative transfer starts here.
+         radld = 0._rb
+         radclrd = 0._rb
+         iclddn = 0
+
+! Downward radiative transfer loop.  
+
+         do lev = nlayers, 1, -1
+               plfrac = fracs(lev,igc)
+               blay = planklay(lev,iband)
+               dplankup = planklev(lev,iband) - blay
+               dplankdn = planklev(lev-1,iband) - blay
+               odepth = secdiff(iband) * taut(lev,igc)
+               if (odepth .lt. 0.0_rb) odepth = 0.0_rb
+! Cloudy layer
+               if (icldlyr(lev).eq.1) then
+                  iclddn = 1
+                  odtot = odepth + odcld(lev,ib)
+                  if (odtot .lt. 0.06_rb) then
+                     atrans(lev) = odepth - 0.5_rb*odepth*odepth
+                     odepth_rec = rec_6*odepth
+                     gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev)
+
+                     atot(lev) =  odtot - 0.5_rb*odtot*odtot
+                     odtot_rec = rec_6*odtot
+                     bbdtot =  plfrac * (blay+dplankdn*odtot_rec)
+                     bbd = plfrac*(blay+dplankdn*odepth_rec)
+                     radld = radld - radld * (atrans(lev) + &
+                         efclfrac(lev,ib) * (1. - atrans(lev))) + &
+                         gassrc + cldfrac(lev) * &
+                         (bbdtot * atot(lev) - gassrc)
+                     drad(lev-1) = drad(lev-1) + radld
+                  
+                     bbugas(lev) =  plfrac * (blay+dplankup*odepth_rec)
+                     bbutot(lev) =  plfrac * (blay+dplankup*odtot_rec)
+
+                  elseif (odepth .le. 0.06_rb) then
+                     atrans(lev) = odepth - 0.5_rb*odepth*odepth
+                     odepth_rec = rec_6*odepth
+                     gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev)
+
+                     odtot = odepth + odcld(lev,ib)
+                     tblind = odtot/(bpade+odtot)
+                     ittot = tblint*tblind + 0.5_rb
+                     tfactot = tfn_tbl(ittot)
+                     bbdtot = plfrac * (blay + tfactot*dplankdn)
+                     bbd = plfrac*(blay+dplankdn*odepth_rec)
+                     atot(lev) = 1._rb - exp_tbl(ittot)
+
+                     radld = radld - radld * (atrans(lev) + &
+                         efclfrac(lev,ib) * (1._rb - atrans(lev))) + &
+                         gassrc + cldfrac(lev) * &
+                         (bbdtot * atot(lev) - gassrc)
+                     drad(lev-1) = drad(lev-1) + radld
+
+                     bbugas(lev) = plfrac * (blay + dplankup*odepth_rec)
+                     bbutot(lev) = plfrac * (blay + tfactot * dplankup)
+
+                  else
+
+                     tblind = odepth/(bpade+odepth)
+                     itgas = tblint*tblind+0.5_rb
+                     odepth = tau_tbl(itgas)
+                     atrans(lev) = 1._rb - exp_tbl(itgas)
+                     tfacgas = tfn_tbl(itgas)
+                     gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn)
+
+                     odtot = odepth + odcld(lev,ib)
+                     tblind = odtot/(bpade+odtot)
+                     ittot = tblint*tblind + 0.5_rb
+                     tfactot = tfn_tbl(ittot)
+                     bbdtot = plfrac * (blay + tfactot*dplankdn)
+                     bbd = plfrac*(blay+tfacgas*dplankdn)
+                     atot(lev) = 1._rb - exp_tbl(ittot)
+
+                  radld = radld - radld * (atrans(lev) + &
+                     efclfrac(lev,ib) * (1._rb - atrans(lev))) + &
+                     gassrc + cldfrac(lev) * &
+                     (bbdtot * atot(lev) - gassrc)
+                  drad(lev-1) = drad(lev-1) + radld
+                  bbugas(lev) = plfrac * (blay + tfacgas * dplankup)
+                  bbutot(lev) = plfrac * (blay + tfactot * dplankup)
+                  endif
+! Clear layer
+               else
+                  if (odepth .le. 0.06_rb) then
+                     atrans(lev) = odepth-0.5_rb*odepth*odepth
+                     odepth = rec_6*odepth
+                     bbd = plfrac*(blay+dplankdn*odepth)
+                     bbugas(lev) = plfrac*(blay+dplankup*odepth)
+                  else
+                     tblind = odepth/(bpade+odepth)
+                     itr = tblint*tblind+0.5_rb
+                     transc = exp_tbl(itr)
+                     atrans(lev) = 1._rb-transc
+                     tausfac = tfn_tbl(itr)
+                     bbd = plfrac*(blay+tausfac*dplankdn)
+                     bbugas(lev) = plfrac * (blay + tausfac * dplankup)
+                  endif   
+                  radld = radld + (bbd-radld)*atrans(lev)
+                  drad(lev-1) = drad(lev-1) + radld
+               endif
+!  Set clear sky stream to total sky stream as long as layers
+!  remain clear.  Streams diverge when a cloud is reached (iclddn=1),
+!  and clear sky stream must be computed separately from that point.
+                  if (iclddn.eq.1) then
+                     radclrd = radclrd + (bbd-radclrd) * atrans(lev) 
+                     clrdrad(lev-1) = clrdrad(lev-1) + radclrd
+                  else
+                     radclrd = radld
+                     clrdrad(lev-1) = drad(lev-1)
+                  endif
+            enddo
+
+! Spectral emissivity & reflectance
+!  Include the contribution of spectrally varying longwave emissivity
+!  and reflection from the surface to the upward radiative transfer.
+!  Note: Spectral and Lambertian reflection are identical for the
+!  diffusivity angle flux integration used here.
+!  Note: The emissivity is applied to plankbnd and dplankbnd_dt when 
+!  they are defined in subroutine setcoef. 
+
+         rad0 = fracs(1,igc) * plankbnd(iband)
+         if (idrv .eq. 1) then
+            d_rad0_dt = fracs(1,igc) * dplankbnd_dt(iband)
+         endif
+
+!  Add in specular reflection of surface downward radiance.
+         reflect = 1._rb - semiss(iband)
+         radlu = rad0 + reflect * radld
+         radclru = rad0 + reflect * radclrd
+
+
+! Upward radiative transfer loop.
+         urad(0) = urad(0) + radlu
+         clrurad(0) = clrurad(0) + radclru
+         if (idrv .eq. 1) then
+            d_radlu_dt = d_rad0_dt
+            d_urad_dt(0) = d_urad_dt(0) + d_radlu_dt
+            d_radclru_dt = d_rad0_dt
+            d_clrurad_dt(0) = d_clrurad_dt(0) + d_radclru_dt
+         endif
+
+         do lev = 1, nlayers
+! Cloudy layer
+            if (icldlyr(lev) .eq. 1) then
+               gassrc = bbugas(lev) * atrans(lev)
+               radlu = radlu - radlu * (atrans(lev) + &
+                   efclfrac(lev,ib) * (1._rb - atrans(lev))) + &
+                   gassrc + cldfrac(lev) * &
+                   (bbutot(lev) * atot(lev) - gassrc)
+               urad(lev) = urad(lev) + radlu
+               if (idrv .eq. 1) then
+                  d_radlu_dt = d_radlu_dt * cldfrac(lev) * (1.0_rb - atot(lev)) + &
+                         d_radlu_dt * (1.0_rb - cldfrac(lev)) * (1.0_rb - atrans(lev))
+                  d_urad_dt(lev) = d_urad_dt(lev) + d_radlu_dt
+               endif
+! Clear layer
+            else
+               radlu = radlu + (bbugas(lev)-radlu)*atrans(lev)
+               urad(lev) = urad(lev) + radlu
+               if (idrv .eq. 1) then
+                  d_radlu_dt = d_radlu_dt * (1.0_rb - atrans(lev))
+                  d_urad_dt(lev) = d_urad_dt(lev) + d_radlu_dt
+               endif
+            endif
+!  Set clear sky stream to total sky stream as long as all layers
+!  are clear (iclddn=0).  Streams must be calculated separately at 
+!  all layers when a cloud is present (iclddn=1), because surface 
+!  reflectance is different for each stream.
+               if (iclddn.eq.1) then
+                  radclru = radclru + (bbugas(lev)-radclru)*atrans(lev) 
+                  clrurad(lev) = clrurad(lev) + radclru
+               else
+                  radclru = radlu
+                  clrurad(lev) = urad(lev)
+               endif
+               if (idrv .eq. 1) then
+                  if (iclddn.eq.1) then
+                     d_radclru_dt = d_radclru_dt * (1.0_rb - atrans(lev))
+                     d_clrurad_dt(lev) = d_clrurad_dt(lev) + d_radclru_dt
+                  else
+                     d_radclru_dt = d_radlu_dt
+                     d_clrurad_dt(lev) = d_urad_dt(lev)
+                  endif
+               endif
+         enddo
+
+! Increment g-point counter
+         igc = igc + 1
+! Return to continue radiative transfer for all g-channels in present band
+         if (igc .le. ngs(iband)) go to 1000
+
+! Process longwave output from band for total and clear streams.
+! Calculate upward, downward, and net flux.
+         do lev = nlayers, 0, -1
+            uflux(lev) = urad(lev)*wtdiff
+            dflux(lev) = drad(lev)*wtdiff
+            urad(lev) = 0.0_rb
+            drad(lev) = 0.0_rb
+            totuflux(lev) = totuflux(lev) + uflux(lev) * delwave(iband)
+            totdflux(lev) = totdflux(lev) + dflux(lev) * delwave(iband)
+            uclfl(lev) = clrurad(lev)*wtdiff
+            dclfl(lev) = clrdrad(lev)*wtdiff
+            clrurad(lev) = 0.0_rb
+            clrdrad(lev) = 0.0_rb
+            totuclfl(lev) = totuclfl(lev) + uclfl(lev) * delwave(iband)
+            totdclfl(lev) = totdclfl(lev) + dclfl(lev) * delwave(iband)
+         enddo
+
+! Calculate total change in upward flux wrt surface temperature
+         if (idrv .eq. 1) then
+            do lev = nlayers, 0, -1
+               duflux_dt(lev) = d_urad_dt(lev) * wtdiff
+               d_urad_dt(lev) = 0.0_rb
+               dtotuflux_dt(lev) = dtotuflux_dt(lev) + duflux_dt(lev) * delwave(iband) * fluxfac
+               duclfl_dt(lev) = d_clrurad_dt(lev) * wtdiff
+               d_clrurad_dt(lev) = 0.0_rb
+               dtotuclfl_dt(lev) = dtotuclfl_dt(lev) + duclfl_dt(lev) * delwave(iband) * fluxfac
+            enddo
+         endif
+
+! End spectral band loop
+      enddo
+
+! Calculate fluxes at surface
+      totuflux(0) = totuflux(0) * fluxfac
+      totdflux(0) = totdflux(0) * fluxfac
+      fnet(0) = totuflux(0) - totdflux(0)
+      totuclfl(0) = totuclfl(0) * fluxfac
+      totdclfl(0) = totdclfl(0) * fluxfac
+      fnetc(0) = totuclfl(0) - totdclfl(0)
+
+! Calculate fluxes at model levels
+      do lev = 1, nlayers
+         totuflux(lev) = totuflux(lev) * fluxfac
+         totdflux(lev) = totdflux(lev) * fluxfac
+         fnet(lev) = totuflux(lev) - totdflux(lev)
+         totuclfl(lev) = totuclfl(lev) * fluxfac
+         totdclfl(lev) = totdclfl(lev) * fluxfac
+         fnetc(lev) = totuclfl(lev) - totdclfl(lev)
+         l = lev - 1
+
+! Calculate heating rates at model layers
+         htr(l)=heatfac*(fnet(l)-fnet(lev))/(pz(l)-pz(lev)) 
+         htrc(l)=heatfac*(fnetc(l)-fnetc(lev))/(pz(l)-pz(lev)) 
+      enddo
+
+! Set heating rate to zero in top layer
+      htr(nlayers) = 0.0_rb
+      htrc(nlayers) = 0.0_rb
+
+      end subroutine rtrn
+
+      end module rrtmg_lw_rtrn
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrnmc.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrnmc.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrnmc.f90	(revision 1585)
@@ -0,0 +1,579 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_rtrnmc.f90,v $
+!     author:    $Author: mike $
+!     revision:  $Revision: 1.7 $
+!     created:   $Date: 2009/11/12 20:52:25 $
+!
+      module rrtmg_lw_rtrnmc
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! --------- Modules ----------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : mg, nbndlw, ngptlw
+      use rrlw_con, only: fluxfac, heatfac
+      use rrlw_wvn, only: delwave, ngb, ngs
+      use rrlw_tbl, only: tblint, bpade, tau_tbl, exp_tbl, tfn_tbl
+      use rrlw_vsn, only: hvrrtc, hnamrtc
+
+      implicit none
+
+      contains
+
+!-----------------------------------------------------------------------------
+      subroutine rtrnmc(nlayers, istart, iend, iout, pz, semiss, ncbands, &
+                        cldfmc, taucmc, planklay, planklev, plankbnd, &
+                        pwvcm, fracs, taut, &
+                        totuflux, totdflux, fnet, htr, &
+                        totuclfl, totdclfl, fnetc, htrc, &
+                        idrv, dplankbnd_dt, dtotuflux_dt, dtotuclfl_dt )
+!-----------------------------------------------------------------------------
+!
+!  Original version:   E. J. Mlawer, et al. RRTM_V3.0
+!  Revision for GCMs:  Michael J. Iacono; October, 2002
+!  Revision for F90:  Michael J. Iacono; June, 2006
+!  Revision for dFdT option: M. J. Iacono and E. J. Mlawer, November 2009
+!
+!  This program calculates the upward fluxes, downward fluxes, and
+!  heating rates for an arbitrary clear or cloudy atmosphere.  The input
+!  to this program is the atmospheric profile, all Planck function
+!  information, and the cloud fraction by layer.  A variable diffusivity 
+!  angle (SECDIFF) is used for the angle integration.  Bands 2-3 and 5-9 
+!  use a value for SECDIFF that varies from 1.50 to 1.80 as a function of 
+!  the column water vapor, and other bands use a value of 1.66.  The Gaussian 
+!  weight appropriate to this angle (WTDIFF=0.5) is applied here.  Note that 
+!  use of the emissivity angle for the flux integration can cause errors of 
+!  1 to 4 W/m2 within cloudy layers.  
+!  Clouds are treated with the McICA stochastic approach and maximum-random
+!  cloud overlap. 
+!  This subroutine also provides the optional capability to calculate
+!  the derivative of upward flux respect to surface temperature using
+!  the pre-tabulated derivative of the Planck function with respect to 
+!  temperature integrated over each spectral band.
+!***************************************************************************
+
+! ------- Declarations -------
+
+! ----- Input -----
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: istart          ! beginning band of calculation
+      integer(kind=im), intent(in) :: iend            ! ending band of calculation
+      integer(kind=im), intent(in) :: iout            ! output option flag
+
+! Atmosphere
+      real(kind=rb), intent(in) :: pz(0:)             ! level (interface) pressures (hPa, mb)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: pwvcm              ! precipitable water vapor (cm)
+      real(kind=rb), intent(in) :: semiss(:)          ! lw surface emissivity
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(in) :: planklay(:,:)      ! 
+                                                      !    Dimensions: (nlayers,nbndlw)
+      real(kind=rb), intent(in) :: planklev(0:,:)     ! 
+                                                      !    Dimensions: (0:nlayers,nbndlw)
+      real(kind=rb), intent(in) :: plankbnd(:)        ! 
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(in) :: fracs(:,:)         ! 
+                                                      !    Dimensions: (nlayers,ngptw)
+      real(kind=rb), intent(in) :: taut(:,:)          ! gaseous + aerosol optical depths
+                                                      !    Dimensions: (nlayers,ngptlw)
+
+! Clouds
+      integer(kind=im), intent(in) :: ncbands         ! number of cloud spectral bands
+      real(kind=rb), intent(in) :: cldfmc(:,:)        ! layer cloud fraction [mcica]
+                                                      !    Dimensions: (ngptlw,nlayers)
+      real(kind=rb), intent(in) :: taucmc(:,:)        ! layer cloud optical depth [mcica]
+                                                      !    Dimensions: (ngptlw,nlayers)
+      integer(kind=im), intent(in) :: idrv            ! flag for calculation of dF/dt from 
+                                                      ! Planck derivative [0=off, 1=on]
+      real(kind=rb), intent(in) :: dplankbnd_dt(:)    ! derivative of Planck function wrt temp
+                                                      !    Dimensions: (nbndlw)
+
+! ----- Output -----
+      real(kind=rb), intent(out) :: totuflux(0:)      ! upward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totdflux(0:)      ! downward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: fnet(0:)          ! net longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: htr(0:)           ! longwave heating rate (k/day)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totuclfl(0:)      ! clear sky upward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totdclfl(0:)      ! clear sky downward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: fnetc(0:)         ! clear sky net longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: htrc(0:)          ! clear sky longwave heating rate (k/day)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: dtotuflux_dt(0:)  ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: dtotuclfl_dt(0:)  ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (0:nlayers)
+
+! ----- Local -----
+! Declarations for radiative transfer
+      real(kind=rb) :: abscld(nlayers,ngptlw)
+      real(kind=rb) :: atot(nlayers)
+      real(kind=rb) :: atrans(nlayers)
+      real(kind=rb) :: bbugas(nlayers)
+      real(kind=rb) :: bbutot(nlayers)
+      real(kind=rb) :: clrurad(0:nlayers)
+      real(kind=rb) :: clrdrad(0:nlayers)
+      real(kind=rb) :: efclfrac(nlayers,ngptlw)
+      real(kind=rb) :: uflux(0:nlayers)
+      real(kind=rb) :: dflux(0:nlayers)
+      real(kind=rb) :: urad(0:nlayers)
+      real(kind=rb) :: drad(0:nlayers)
+      real(kind=rb) :: uclfl(0:nlayers)
+      real(kind=rb) :: dclfl(0:nlayers)
+      real(kind=rb) :: odcld(nlayers,ngptlw)
+
+
+      real(kind=rb) :: secdiff(nbndlw)                 ! secant of diffusivity angle
+      real(kind=rb) :: a0(nbndlw),a1(nbndlw),a2(nbndlw)! diffusivity angle adjustment coefficients
+      real(kind=rb) :: wtdiff, rec_6
+      real(kind=rb) :: transcld, radld, radclrd, plfrac, blay, dplankup, dplankdn
+      real(kind=rb) :: odepth, odtot, odepth_rec, odtot_rec, gassrc
+      real(kind=rb) :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, tausfac
+      real(kind=rb) :: rad0, reflect, radlu, radclru
+
+      real(kind=rb) :: duflux_dt(0:nlayers)
+      real(kind=rb) :: duclfl_dt(0:nlayers)
+      real(kind=rb) :: d_urad_dt(0:nlayers)
+      real(kind=rb) :: d_clrurad_dt(0:nlayers)
+      real(kind=rb) :: d_rad0_dt, d_radlu_dt, d_radclru_dt
+
+      integer(kind=im) :: icldlyr(nlayers)                  ! flag for cloud in layer
+      integer(kind=im) :: ibnd, ib, iband, lay, lev, l, ig  ! loop indices
+      integer(kind=im) :: igc                               ! g-point interval counter
+      integer(kind=im) :: iclddn                            ! flag for cloud in down path
+      integer(kind=im) :: ittot, itgas, itr                 ! lookup table indices
+
+! ------- Definitions -------
+! input
+!    nlayers                      ! number of model layers
+!    ngptlw                       ! total number of g-point subintervals
+!    nbndlw                       ! number of longwave spectral bands
+!    ncbands                      ! number of spectral bands for clouds
+!    secdiff                      ! diffusivity angle
+!    wtdiff                       ! weight for radiance to flux conversion
+!    pavel                        ! layer pressures (mb)
+!    pz                           ! level (interface) pressures (mb)
+!    tavel                        ! layer temperatures (k)
+!    tz                           ! level (interface) temperatures(mb)
+!    tbound                       ! surface temperature (k)
+!    cldfrac                      ! layer cloud fraction
+!    taucloud                     ! layer cloud optical depth
+!    itr                          ! integer look-up table index
+!    icldlyr                      ! flag for cloudy layers
+!    iclddn                       ! flag for cloud in column at any layer
+!    semiss                       ! surface emissivities for each band
+!    reflect                      ! surface reflectance
+!    bpade                        ! 1/(pade constant)
+!    tau_tbl                      ! clear sky optical depth look-up table
+!    exp_tbl                      ! exponential look-up table for transmittance
+!    tfn_tbl                      ! tau transition function look-up table
+
+! local
+!    atrans                       ! gaseous absorptivity
+!    abscld                       ! cloud absorptivity
+!    atot                         ! combined gaseous and cloud absorptivity
+!    odclr                        ! clear sky (gaseous) optical depth
+!    odcld                        ! cloud optical depth
+!    odtot                        ! optical depth of gas and cloud
+!    tfacgas                      ! gas-only pade factor, used for planck fn
+!    tfactot                      ! gas and cloud pade factor, used for planck fn
+!    bbdgas                       ! gas-only planck function for downward rt
+!    bbugas                       ! gas-only planck function for upward rt
+!    bbdtot                       ! gas and cloud planck function for downward rt
+!    bbutot                       ! gas and cloud planck function for upward calc.
+!    gassrc                       ! source radiance due to gas only
+!    efclfrac                     ! effective cloud fraction
+!    radlu                        ! spectrally summed upward radiance 
+!    radclru                      ! spectrally summed clear sky upward radiance 
+!    urad                         ! upward radiance by layer
+!    clrurad                      ! clear sky upward radiance by layer
+!    radld                        ! spectrally summed downward radiance 
+!    radclrd                      ! spectrally summed clear sky downward radiance 
+!    drad                         ! downward radiance by layer
+!    clrdrad                      ! clear sky downward radiance by layer
+!    d_radlu_dt                   ! spectrally summed upward radiance 
+!    d_radclru_dt                 ! spectrally summed clear sky upward radiance 
+!    d_urad_dt                    ! upward radiance by layer
+!    d_clrurad_dt                 ! clear sky upward radiance by layer
+
+! output
+!    totuflux                     ! upward longwave flux (w/m2)
+!    totdflux                     ! downward longwave flux (w/m2)
+!    fnet                         ! net longwave flux (w/m2)
+!    htr                          ! longwave heating rate (k/day)
+!    totuclfl                     ! clear sky upward longwave flux (w/m2)
+!    totdclfl                     ! clear sky downward longwave flux (w/m2)
+!    fnetc                        ! clear sky net longwave flux (w/m2)
+!    htrc                         ! clear sky longwave heating rate (k/day)
+!    dtotuflux_dt                 ! change in upward longwave flux (w/m2/k)
+!                                 ! with respect to surface temperature
+!    dtotuclfl_dt                 ! change in clear sky upward longwave flux (w/m2/k)
+!                                 ! with respect to surface temperature
+
+
+! This secant and weight corresponds to the standard diffusivity 
+! angle.  This initial value is redefined below for some bands.
+      data wtdiff /0.5_rb/
+      data rec_6 /0.166667_rb/
+
+! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
+! and 1.80) as a function of total column water vapor.  The function
+! has been defined to minimize flux and cooling rate errors in these bands
+! over a wide range of precipitable water values.
+      data a0 / 1.66_rb,  1.55_rb,  1.58_rb,  1.66_rb, &
+                1.54_rb, 1.454_rb,  1.89_rb,  1.33_rb, &
+               1.668_rb,  1.66_rb,  1.66_rb,  1.66_rb, &
+                1.66_rb,  1.66_rb,  1.66_rb,  1.66_rb /
+      data a1 / 0.00_rb,  0.25_rb,  0.22_rb,  0.00_rb, &
+                0.13_rb, 0.446_rb, -0.10_rb,  0.40_rb, &
+              -0.006_rb,  0.00_rb,  0.00_rb,  0.00_rb, &
+                0.00_rb,  0.00_rb,  0.00_rb,  0.00_rb /
+      data a2 / 0.00_rb, -12.0_rb, -11.7_rb,  0.00_rb, &
+               -0.72_rb,-0.243_rb,  0.19_rb,-0.062_rb, &
+               0.414_rb,  0.00_rb,  0.00_rb,  0.00_rb, &
+                0.00_rb,  0.00_rb,  0.00_rb,  0.00_rb /
+
+      hvrrtc = '$Revision: 1.7 $'
+
+      do ibnd = 1,nbndlw
+         if (ibnd.eq.1 .or. ibnd.eq.4 .or. ibnd.ge.10) then
+           secdiff(ibnd) = 1.66_rb
+         else
+           secdiff(ibnd) = a0(ibnd) + a1(ibnd)*exp(a2(ibnd)*pwvcm)
+           if (secdiff(ibnd) .gt. 1.80_rb) secdiff(ibnd) = 1.80_rb
+           if (secdiff(ibnd) .lt. 1.50_rb) secdiff(ibnd) = 1.50_rb
+         endif
+      enddo
+
+      urad(0) = 0.0_rb
+      drad(0) = 0.0_rb
+      totuflux(0) = 0.0_rb
+      totdflux(0) = 0.0_rb
+      clrurad(0) = 0.0_rb
+      clrdrad(0) = 0.0_rb
+      totuclfl(0) = 0.0_rb
+      totdclfl(0) = 0.0_rb
+      if (idrv .eq. 1) then
+         d_urad_dt(0) = 0.0_rb
+         d_clrurad_dt(0) = 0.0_rb
+         dtotuflux_dt(0) = 0.0_rb
+         dtotuclfl_dt(0) = 0.0_rb
+      endif
+
+      do lay = 1, nlayers
+         urad(lay) = 0.0_rb
+         drad(lay) = 0.0_rb
+         totuflux(lay) = 0.0_rb
+         totdflux(lay) = 0.0_rb
+         clrurad(lay) = 0.0_rb
+         clrdrad(lay) = 0.0_rb
+         totuclfl(lay) = 0.0_rb
+         totdclfl(lay) = 0.0_rb
+         icldlyr(lay) = 0
+         if (idrv .eq. 1) then
+            d_urad_dt(lay) = 0.0_rb
+            d_clrurad_dt(lay) = 0.0_rb
+            dtotuflux_dt(lay) = 0.0_rb
+            dtotuclfl_dt(lay) = 0.0_rb
+         endif
+
+! Change to band loop?
+         do ig = 1, ngptlw
+            if (cldfmc(ig,lay) .eq. 1._rb) then
+               ib = ngb(ig)
+               odcld(lay,ig) = secdiff(ib) * taucmc(ig,lay)
+               transcld = exp(-odcld(lay,ig))
+               abscld(lay,ig) = 1._rb - transcld
+               efclfrac(lay,ig) = abscld(lay,ig) * cldfmc(ig,lay)
+               icldlyr(lay) = 1
+            else
+               odcld(lay,ig) = 0.0_rb
+               abscld(lay,ig) = 0.0_rb
+               efclfrac(lay,ig) = 0.0_rb
+            endif
+         enddo
+
+      enddo
+
+      igc = 1
+! Loop over frequency bands.
+      do iband = istart, iend
+
+! Reinitialize g-point counter for each band if output for each band is requested.
+         if (iout.gt.0.and.iband.ge.2) igc = ngs(iband-1)+1
+
+! Loop over g-channels.
+ 1000    continue
+
+! Radiative transfer starts here.
+         radld = 0._rb
+         radclrd = 0._rb
+         iclddn = 0
+
+! Downward radiative transfer loop.  
+
+         do lev = nlayers, 1, -1
+               plfrac = fracs(lev,igc)
+               blay = planklay(lev,iband)
+               dplankup = planklev(lev,iband) - blay
+               dplankdn = planklev(lev-1,iband) - blay
+               odepth = secdiff(iband) * taut(lev,igc)
+               if (odepth .lt. 0.0_rb) odepth = 0.0_rb
+!  Cloudy layer
+               if (icldlyr(lev).eq.1) then
+                  iclddn = 1
+                  odtot = odepth + odcld(lev,igc)
+                  if (odtot .lt. 0.06_rb) then
+                     atrans(lev) = odepth - 0.5_rb*odepth*odepth
+                     odepth_rec = rec_6*odepth
+                     gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev)
+
+                     atot(lev) =  odtot - 0.5_rb*odtot*odtot
+                     odtot_rec = rec_6*odtot
+                     bbdtot =  plfrac * (blay+dplankdn*odtot_rec)
+                     bbd = plfrac*(blay+dplankdn*odepth_rec)
+                     radld = radld - radld * (atrans(lev) + &
+                         efclfrac(lev,igc) * (1. - atrans(lev))) + &
+                         gassrc + cldfmc(igc,lev) * &
+                         (bbdtot * atot(lev) - gassrc)
+                     drad(lev-1) = drad(lev-1) + radld
+                  
+                     bbugas(lev) =  plfrac * (blay+dplankup*odepth_rec)
+                     bbutot(lev) =  plfrac * (blay+dplankup*odtot_rec)
+
+                  elseif (odepth .le. 0.06_rb) then
+                     atrans(lev) = odepth - 0.5_rb*odepth*odepth
+                     odepth_rec = rec_6*odepth
+                     gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev)
+
+                     odtot = odepth + odcld(lev,igc)
+                     tblind = odtot/(bpade+odtot)
+                     ittot = tblint*tblind + 0.5_rb
+                     tfactot = tfn_tbl(ittot)
+                     bbdtot = plfrac * (blay + tfactot*dplankdn)
+                     bbd = plfrac*(blay+dplankdn*odepth_rec)
+                     atot(lev) = 1. - exp_tbl(ittot)
+
+                     radld = radld - radld * (atrans(lev) + &
+                         efclfrac(lev,igc) * (1._rb - atrans(lev))) + &
+                         gassrc + cldfmc(igc,lev) * &
+                         (bbdtot * atot(lev) - gassrc)
+                     drad(lev-1) = drad(lev-1) + radld
+
+                     bbugas(lev) = plfrac * (blay + dplankup*odepth_rec)
+                     bbutot(lev) = plfrac * (blay + tfactot * dplankup)
+
+                  else
+
+                     tblind = odepth/(bpade+odepth)
+                     itgas = tblint*tblind+0.5_rb
+                     odepth = tau_tbl(itgas)
+                     atrans(lev) = 1._rb - exp_tbl(itgas)
+                     tfacgas = tfn_tbl(itgas)
+                     gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn)
+
+                     odtot = odepth + odcld(lev,igc)
+                     tblind = odtot/(bpade+odtot)
+                     ittot = tblint*tblind + 0.5_rb
+                     tfactot = tfn_tbl(ittot)
+                     bbdtot = plfrac * (blay + tfactot*dplankdn)
+                     bbd = plfrac*(blay+tfacgas*dplankdn)
+                     atot(lev) = 1._rb - exp_tbl(ittot)
+
+                  radld = radld - radld * (atrans(lev) + &
+                    efclfrac(lev,igc) * (1._rb - atrans(lev))) + &
+                    gassrc + cldfmc(igc,lev) * &
+                    (bbdtot * atot(lev) - gassrc)
+                  drad(lev-1) = drad(lev-1) + radld
+                  bbugas(lev) = plfrac * (blay + tfacgas * dplankup)
+                  bbutot(lev) = plfrac * (blay + tfactot * dplankup)
+                  endif
+!  Clear layer
+               else
+                  if (odepth .le. 0.06_rb) then
+                     atrans(lev) = odepth-0.5_rb*odepth*odepth
+                     odepth = rec_6*odepth
+                     bbd = plfrac*(blay+dplankdn*odepth)
+                     bbugas(lev) = plfrac*(blay+dplankup*odepth)
+                  else
+                     tblind = odepth/(bpade+odepth)
+                     itr = tblint*tblind+0.5_rb
+                     transc = exp_tbl(itr)
+                     atrans(lev) = 1._rb-transc
+                     tausfac = tfn_tbl(itr)
+                     bbd = plfrac*(blay+tausfac*dplankdn)
+                     bbugas(lev) = plfrac * (blay + tausfac * dplankup)
+                  endif   
+                  radld = radld + (bbd-radld)*atrans(lev)
+                  drad(lev-1) = drad(lev-1) + radld
+               endif
+!  Set clear sky stream to total sky stream as long as layers
+!  remain clear.  Streams diverge when a cloud is reached (iclddn=1),
+!  and clear sky stream must be computed separately from that point.
+                  if (iclddn.eq.1) then
+                     radclrd = radclrd + (bbd-radclrd) * atrans(lev) 
+                     clrdrad(lev-1) = clrdrad(lev-1) + radclrd
+                  else
+                     radclrd = radld
+                     clrdrad(lev-1) = drad(lev-1)
+                  endif
+            enddo
+
+! Spectral emissivity & reflectance
+!  Include the contribution of spectrally varying longwave emissivity
+!  and reflection from the surface to the upward radiative transfer.
+!  Note: Spectral and Lambertian reflection are identical for the
+!  diffusivity angle flux integration used here.
+!  Note: The emissivity is applied to plankbnd and dplankbnd_dt when 
+!  they are defined in subroutine setcoef. 
+
+         rad0 = fracs(1,igc) * plankbnd(iband)
+         if (idrv .eq. 1) then
+            d_rad0_dt = fracs(1,igc) * dplankbnd_dt(iband)
+         endif
+
+!  Add in specular reflection of surface downward radiance.
+         reflect = 1._rb - semiss(iband)
+         radlu = rad0 + reflect * radld
+         radclru = rad0 + reflect * radclrd
+
+
+! Upward radiative transfer loop.
+         urad(0) = urad(0) + radlu
+         clrurad(0) = clrurad(0) + radclru
+         if (idrv .eq. 1) then
+            d_radlu_dt = d_rad0_dt
+            d_urad_dt(0) = d_urad_dt(0) + d_radlu_dt
+            d_radclru_dt = d_rad0_dt
+            d_clrurad_dt(0) = d_clrurad_dt(0) + d_radclru_dt
+         endif
+
+         do lev = 1, nlayers
+!  Cloudy layer
+            if (icldlyr(lev) .eq. 1) then
+               gassrc = bbugas(lev) * atrans(lev)
+               radlu = radlu - radlu * (atrans(lev) + &
+                   efclfrac(lev,igc) * (1._rb - atrans(lev))) + &
+                   gassrc + cldfmc(igc,lev) * &
+                   (bbutot(lev) * atot(lev) - gassrc)
+               urad(lev) = urad(lev) + radlu
+               if (idrv .eq. 1) then
+                  d_radlu_dt = d_radlu_dt * cldfmc(igc,lev) * (1.0_rb - atot(lev)) + &
+                         d_radlu_dt * (1.0_rb - cldfmc(igc,lev)) * (1.0_rb - atrans(lev))
+                  d_urad_dt(lev) = d_urad_dt(lev) + d_radlu_dt
+               endif
+!  Clear layer
+            else
+               radlu = radlu + (bbugas(lev)-radlu)*atrans(lev)
+               urad(lev) = urad(lev) + radlu
+               if (idrv .eq. 1) then
+                  d_radlu_dt = d_radlu_dt * (1.0_rb - atrans(lev))
+                  d_urad_dt(lev) = d_urad_dt(lev) + d_radlu_dt
+               endif
+            endif
+!  Set clear sky stream to total sky stream as long as all layers
+!  are clear (iclddn=0).  Streams must be calculated separately at 
+!  all layers when a cloud is present (ICLDDN=1), because surface 
+!  reflectance is different for each stream.
+               if (iclddn.eq.1) then
+                  radclru = radclru + (bbugas(lev)-radclru)*atrans(lev) 
+                  clrurad(lev) = clrurad(lev) + radclru
+               else
+                  radclru = radlu
+                  clrurad(lev) = urad(lev)
+               endif
+               if (idrv .eq. 1) then
+                  if (iclddn.eq.1) then
+                     d_radclru_dt = d_radclru_dt * (1.0_rb - atrans(lev))
+                     d_clrurad_dt(lev) = d_clrurad_dt(lev) + d_radclru_dt
+                  else
+                     d_radclru_dt = d_radlu_dt
+                     d_clrurad_dt(lev) = d_urad_dt(lev)
+                  endif
+               endif
+         enddo
+
+! Increment g-point counter
+         igc = igc + 1
+! Return to continue radiative transfer for all g-channels in present band
+         if (igc .le. ngs(iband)) go to 1000
+
+! Process longwave output from band for total and clear streams.
+! Calculate upward, downward, and net flux.
+         do lev = nlayers, 0, -1
+            uflux(lev) = urad(lev)*wtdiff
+            dflux(lev) = drad(lev)*wtdiff
+            urad(lev) = 0.0_rb
+            drad(lev) = 0.0_rb
+            totuflux(lev) = totuflux(lev) + uflux(lev) * delwave(iband)
+            totdflux(lev) = totdflux(lev) + dflux(lev) * delwave(iband)
+            uclfl(lev) = clrurad(lev)*wtdiff
+            dclfl(lev) = clrdrad(lev)*wtdiff
+            clrurad(lev) = 0.0_rb
+            clrdrad(lev) = 0.0_rb
+            totuclfl(lev) = totuclfl(lev) + uclfl(lev) * delwave(iband)
+            totdclfl(lev) = totdclfl(lev) + dclfl(lev) * delwave(iband)
+         enddo
+
+! Calculate total change in upward flux wrt surface temperature
+         if (idrv .eq. 1) then
+            do lev = nlayers, 0, -1
+               duflux_dt(lev) = d_urad_dt(lev) * wtdiff
+               d_urad_dt(lev) = 0.0_rb
+               dtotuflux_dt(lev) = dtotuflux_dt(lev) + duflux_dt(lev) * delwave(iband) * fluxfac
+               duclfl_dt(lev) = d_clrurad_dt(lev) * wtdiff
+               d_clrurad_dt(lev) = 0.0_rb
+               dtotuclfl_dt(lev) = dtotuclfl_dt(lev) + duclfl_dt(lev) * delwave(iband) * fluxfac
+            enddo
+         endif
+
+! End spectral band loop
+      enddo
+
+! Calculate fluxes at surface
+      totuflux(0) = totuflux(0) * fluxfac
+      totdflux(0) = totdflux(0) * fluxfac
+      fnet(0) = totuflux(0) - totdflux(0)
+      totuclfl(0) = totuclfl(0) * fluxfac
+      totdclfl(0) = totdclfl(0) * fluxfac
+      fnetc(0) = totuclfl(0) - totdclfl(0)
+
+! Calculate fluxes at model levels
+      do lev = 1, nlayers
+         totuflux(lev) = totuflux(lev) * fluxfac
+         totdflux(lev) = totdflux(lev) * fluxfac
+         fnet(lev) = totuflux(lev) - totdflux(lev)
+         totuclfl(lev) = totuclfl(lev) * fluxfac
+         totdclfl(lev) = totdclfl(lev) * fluxfac
+         fnetc(lev) = totuclfl(lev) - totdclfl(lev)
+         l = lev - 1
+
+! Calculate heating rates at model layers
+         htr(l)=heatfac*(fnet(l)-fnet(lev))/(pz(l)-pz(lev)) 
+         htrc(l)=heatfac*(fnetc(l)-fnetc(lev))/(pz(l)-pz(lev)) 
+      enddo
+
+! Set heating rate to zero in top layer
+      htr(nlayers) = 0.0_rb
+      htrc(nlayers) = 0.0_rb
+
+      end subroutine rtrnmc
+
+      end module rrtmg_lw_rtrnmc
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrnmr.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrnmr.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_rtrnmr.f90	(revision 1585)
@@ -0,0 +1,782 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_rtrnmr.f90,v $
+!     author:    $Author: mike $
+!     revision:  $Revision: 1.7 $
+!     created:   $Date: 2009/11/12 20:52:26 $
+!
+      module rrtmg_lw_rtrnmr
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : mg, nbndlw, ngptlw
+      use rrlw_con, only: fluxfac, heatfac
+      use rrlw_wvn, only: delwave, ngs
+      use rrlw_tbl, only: tblint, bpade, tau_tbl, exp_tbl, tfn_tbl
+      use rrlw_vsn, only: hvrrtx, hnamrtx
+
+      implicit none
+
+      contains
+
+!-----------------------------------------------------------------------------
+      subroutine rtrnmr(nlayers, istart, iend, iout, pz, semiss, ncbands, &
+                        cldfrac, taucloud, planklay, planklev, plankbnd, &
+                        pwvcm, fracs, taut, & 
+                        totuflux, totdflux, fnet, htr, &
+                        totuclfl, totdclfl, fnetc, htrc, &
+                        idrv, dplankbnd_dt, dtotuflux_dt, dtotuclfl_dt )
+!-----------------------------------------------------------------------------
+!
+!  Original version:   E. J. Mlawer, et al. RRTM_V3.0
+!  Revision for GCMs:  Michael J. Iacono; October, 2002
+!  Revision for F90:  Michael J. Iacono; June, 2006
+!  Revision for dFdT option: M. J. Iacono and E. J. Mlawer, November 2009
+!
+!  This program calculates the upward fluxes, downward fluxes, and
+!  heating rates for an arbitrary clear or cloudy atmosphere.  The input
+!  to this program is the atmospheric profile, all Planck function
+!  information, and the cloud fraction by layer.  A variable diffusivity 
+!  angle (SECDIFF) is used for the angle integration.  Bands 2-3 and 5-9 
+!  use a value for SECDIFF that varies from 1.50 to 1.80 as a function of 
+!  the column water vapor, and other bands use a value of 1.66.  The Gaussian 
+!  weight appropriate to this angle (WTDIFF=0.5) is applied here.  Note that 
+!  use of the emissivity angle for the flux integration can cause errors of 
+!  1 to 4 W/m2 within cloudy layers.  
+!  Clouds are treated with a maximum-random cloud overlap method.
+!  This subroutine also provides the optional capability to calculate
+!  the derivative of upward flux respect to surface temperature using
+!  the pre-tabulated derivative of the Planck function with respect to 
+!  temperature integrated over each spectral band.
+!***************************************************************************
+
+! ------- Declarations -------
+
+! ----- Input -----
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: istart          ! beginning band of calculation
+      integer(kind=im), intent(in) :: iend            ! ending band of calculation
+      integer(kind=im), intent(in) :: iout            ! output option flag
+
+! Atmosphere
+      real(kind=rb), intent(in) :: pz(0:)             ! level (interface) pressures (hPa, mb)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: pwvcm              ! precipitable water vapor (cm)
+      real(kind=rb), intent(in) :: semiss(:)          ! lw surface emissivity
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(in) :: planklay(:,:)      ! 
+                                                      !    Dimensions: (nlayers,nbndlw)
+      real(kind=rb), intent(in) :: planklev(0:,:)     ! 
+                                                      !    Dimensions: (0:nlayers,nbndlw)
+      real(kind=rb), intent(in) :: plankbnd(:)        ! 
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(in) :: fracs(:,:)         ! 
+                                                      !    Dimensions: (nlayers,ngptw)
+      real(kind=rb), intent(in) :: taut(:,:)          ! gaseous + aerosol optical depths
+                                                      !    Dimensions: (nlayers,ngptlw)
+
+! Clouds
+      integer(kind=im), intent(in) :: ncbands         ! number of cloud spectral bands
+      real(kind=rb), intent(in) :: cldfrac(:)         ! layer cloud fraction
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: taucloud(:,:)      ! layer cloud optical depth
+                                                      !    Dimensions: (nlayers,nbndlw)
+      integer(kind=im), intent(in) :: idrv            ! flag for calculation of dF/dt from 
+                                                      ! Planck derivative [0=off, 1=on]
+      real(kind=rb), intent(in) :: dplankbnd_dt(:)    ! derivative of Planck function wrt temp
+                                                      !    Dimensions: (nbndlw)
+
+! ----- Output -----
+      real(kind=rb), intent(out) :: totuflux(0:)      ! upward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totdflux(0:)      ! downward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: fnet(0:)          ! net longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: htr(0:)           ! longwave heating rate (k/day)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totuclfl(0:)      ! clear sky upward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: totdclfl(0:)      ! clear sky downward longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: fnetc(0:)         ! clear sky net longwave flux (w/m2)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: htrc(0:)          ! clear sky longwave heating rate (k/day)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: dtotuflux_dt(0:)  ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(out) :: dtotuclfl_dt(0:)  ! change in upward longwave flux (w/m2/k)
+                                                      ! with respect to surface temperature
+                                                      !    Dimensions: (0:nlayers)
+
+! ----- Local -----
+! Declarations for radiative transfer
+      real(kind=rb) :: abscld(nlayers,nbndlw)
+      real(kind=rb) :: atot(nlayers)
+      real(kind=rb) :: atrans(nlayers)
+      real(kind=rb) :: bbugas(nlayers)
+      real(kind=rb) :: bbutot(nlayers)
+      real(kind=rb) :: clrurad(0:nlayers)
+      real(kind=rb) :: clrdrad(0:nlayers)
+      real(kind=rb) :: efclfrac(nlayers,nbndlw)
+      real(kind=rb) :: uflux(0:nlayers)
+      real(kind=rb) :: dflux(0:nlayers)
+      real(kind=rb) :: urad(0:nlayers)
+      real(kind=rb) :: drad(0:nlayers)
+      real(kind=rb) :: uclfl(0:nlayers)
+      real(kind=rb) :: dclfl(0:nlayers)
+      real(kind=rb) :: odcld(nlayers,nbndlw)
+
+      real(kind=rb) :: secdiff(nbndlw)                 ! secant of diffusivity angle
+      real(kind=rb) :: a0(nbndlw),a1(nbndlw),a2(nbndlw)! diffusivity angle adjustment coefficients
+      real(kind=rb) :: wtdiff, rec_6
+      real(kind=rb) :: transcld, radld, radclrd, plfrac, blay, dplankup, dplankdn
+      real(kind=rb) :: odepth, odtot, odepth_rec, odtot_rec, gassrc, ttot
+      real(kind=rb) :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, tausfac
+      real(kind=rb) :: rad0, reflect, radlu, radclru
+
+      real(kind=rb) :: duflux_dt(0:nlayers)
+      real(kind=rb) :: duclfl_dt(0:nlayers)
+      real(kind=rb) :: d_urad_dt(0:nlayers)
+      real(kind=rb) :: d_clrurad_dt(0:nlayers)
+      real(kind=rb) :: d_rad0_dt, d_radlu_dt, d_radclru_dt
+
+      integer(kind=im) :: icldlyr(nlayers)             ! flag for cloud in layer
+      integer(kind=im) :: ibnd, ib, iband, lay, lev, l ! loop indices
+      integer(kind=im) :: igc                          ! g-point interval counter
+      integer(kind=im) :: iclddn                       ! flag for cloud in down path
+      integer(kind=im) :: ittot, itgas, itr            ! lookup table indices
+      integer(kind=im) :: ipat(16,0:2)
+
+! Declarations for cloud overlap adjustment
+      real(kind=rb) :: faccld1(nlayers+1),faccld2(nlayers+1)
+      real(kind=rb) :: facclr1(nlayers+1),facclr2(nlayers+1)
+      real(kind=rb) :: faccmb1(nlayers+1),faccmb2(nlayers+1)
+      real(kind=rb) :: faccld1d(0:nlayers),faccld2d(0:nlayers)
+      real(kind=rb) :: facclr1d(0:nlayers),facclr2d(0:nlayers)
+      real(kind=rb) :: faccmb1d(0:nlayers),faccmb2d(0:nlayers)
+
+      real(kind=rb) :: fmax, fmin, rat1, rat2
+      real(kind=rb) :: clrradd, cldradd, clrradu, cldradu, oldclr, oldcld
+      real(kind=rb) :: rad, cldsrc, radmod
+
+      integer(kind=im) :: istcld(nlayers+1),istcldd(0:nlayers)
+
+! ------- Definitions -------
+! input
+!    nlayers                      ! number of model layers
+!    ngptlw                       ! total number of g-point subintervals
+!    nbndlw                       ! number of longwave spectral bands
+!    ncbands                      ! number of spectral bands for clouds
+!    secdiff                      ! diffusivity angle
+!    wtdiff                       ! weight for radiance to flux conversion
+!    pavel                        ! layer pressures (mb)
+!    pz                           ! level (interface) pressures (mb)
+!    tavel                        ! layer temperatures (k)
+!    tz                           ! level (interface) temperatures(mb)
+!    tbound                       ! surface temperature (k)
+!    cldfrac                      ! layer cloud fraction
+!    taucloud                     ! layer cloud optical depth
+!    itr                          ! integer look-up table index
+!    icldlyr                      ! flag for cloudy layers
+!    iclddn                       ! flag for cloud in column at any layer
+!    semiss                       ! surface emissivities for each band
+!    reflect                      ! surface reflectance
+!    bpade                        ! 1/(pade constant)
+!    tau_tbl                      ! clear sky optical depth look-up table
+!    exp_tbl                      ! exponential look-up table for transmittance
+!    tfn_tbl                      ! tau transition function look-up table
+
+! local
+!    atrans                       ! gaseous absorptivity
+!    abscld                       ! cloud absorptivity
+!    atot                         ! combined gaseous and cloud absorptivity
+!    odclr                        ! clear sky (gaseous) optical depth
+!    odcld                        ! cloud optical depth
+!    odtot                        ! optical depth of gas and cloud
+!    tfacgas                      ! gas-only pade factor, used for planck fn
+!    tfactot                      ! gas and cloud pade factor, used for planck fn
+!    bbdgas                       ! gas-only planck function for downward rt
+!    bbugas                       ! gas-only planck function for upward rt
+!    bbdtot                       ! gas and cloud planck function for downward rt
+!    bbutot                       ! gas and cloud planck function for upward calc.
+!    gassrc                       ! source radiance due to gas only
+!    efclfrac                     ! effective cloud fraction
+!    radlu                        ! spectrally summed upward radiance 
+!    radclru                      ! spectrally summed clear sky upward radiance 
+!    urad                         ! upward radiance by layer
+!    clrurad                      ! clear sky upward radiance by layer
+!    radld                        ! spectrally summed downward radiance 
+!    radclrd                      ! spectrally summed clear sky downward radiance 
+!    drad                         ! downward radiance by layer
+!    clrdrad                      ! clear sky downward radiance by layer
+!    d_radlu_dt                   ! spectrally summed upward radiance 
+!    d_radclru_dt                 ! spectrally summed clear sky upward radiance 
+!    d_urad_dt                    ! upward radiance by layer
+!    d_clrurad_dt                 ! clear sky upward radiance by layer
+
+! output
+!    totuflux                     ! upward longwave flux (w/m2)
+!    totdflux                     ! downward longwave flux (w/m2)
+!    fnet                         ! net longwave flux (w/m2)
+!    htr                          ! longwave heating rate (k/day)
+!    totuclfl                     ! clear sky upward longwave flux (w/m2)
+!    totdclfl                     ! clear sky downward longwave flux (w/m2)
+!    fnetc                        ! clear sky net longwave flux (w/m2)
+!    htrc                         ! clear sky longwave heating rate (k/day)
+!    dtotuflux_dt                 ! change in upward longwave flux (w/m2/k)
+!                                 ! with respect to surface temperature
+!    dtotuclfl_dt                 ! change in clear sky upward longwave flux (w/m2/k)
+!                                 ! with respect to surface temperature
+
+
+! These arrays indicate the spectral 'region' (used in the 
+! calculation of ice cloud optical depths) corresponding
+! to each spectral band.  See cldprop.f for more details.
+      data ipat /1,1,1,1,1,1,1,1,1, 1, 1, 1, 1, 1, 1, 1, &
+                 1,2,3,3,3,4,4,4,5, 5, 5, 5, 5, 5, 5, 5, &
+                 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/
+
+! This secant and weight corresponds to the standard diffusivity 
+! angle.  This initial value is redefined below for some bands.
+      data wtdiff /0.5_rb/
+      data rec_6 /0.166667_rb/
+
+! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
+! and 1.80) as a function of total column water vapor.  The function
+! has been defined to minimize flux and cooling rate errors in these bands
+! over a wide range of precipitable water values.
+      data a0 / 1.66_rb,  1.55_rb,  1.58_rb,  1.66_rb, &
+                1.54_rb, 1.454_rb,  1.89_rb,  1.33_rb, &
+               1.668_rb,  1.66_rb,  1.66_rb,  1.66_rb, &
+                1.66_rb,  1.66_rb,  1.66_rb,  1.66_rb /
+      data a1 / 0.00_rb,  0.25_rb,  0.22_rb,  0.00_rb, &
+                0.13_rb, 0.446_rb, -0.10_rb,  0.40_rb, &
+              -0.006_rb,  0.00_rb,  0.00_rb,  0.00_rb, &
+                0.00_rb,  0.00_rb,  0.00_rb,  0.00_rb /
+      data a2 / 0.00_rb, -12.0_rb, -11.7_rb,  0.00_rb, &
+               -0.72_rb,-0.243_rb,  0.19_rb,-0.062_rb, &
+               0.414_rb,  0.00_rb,  0.00_rb,  0.00_rb, &
+                0.00_rb,  0.00_rb,  0.00_rb,  0.00_rb /
+
+      do ibnd = 1,nbndlw
+         if (ibnd.eq.1 .or. ibnd.eq.4 .or. ibnd.ge.10) then
+           secdiff(ibnd) = 1.66_rb
+         else
+           secdiff(ibnd) = a0(ibnd) + a1(ibnd)*exp(a2(ibnd)*pwvcm)
+           if (secdiff(ibnd) .gt. 1.80_rb) secdiff(ibnd) = 1.80_rb
+           if (secdiff(ibnd) .lt. 1.50_rb) secdiff(ibnd) = 1.50_rb
+         endif
+      enddo
+
+      hvrrtx = '$Revision: 1.7 $'
+
+      urad(0) = 0.0_rb
+      drad(0) = 0.0_rb
+      totuflux(0) = 0.0_rb
+      totdflux(0) = 0.0_rb
+      clrurad(0) = 0.0_rb
+      clrdrad(0) = 0.0_rb
+      totuclfl(0) = 0.0_rb
+      totdclfl(0) = 0.0_rb
+      if (idrv .eq. 1) then
+         d_urad_dt(0) = 0.0_rb
+         d_clrurad_dt(0) = 0.0_rb
+         dtotuflux_dt(0) = 0.0_rb
+         dtotuclfl_dt(0) = 0.0_rb
+      endif
+
+      do lay = 1, nlayers
+         urad(lay) = 0.0_rb
+         drad(lay) = 0.0_rb
+         totuflux(lay) = 0.0_rb
+         totdflux(lay) = 0.0_rb
+         clrurad(lay) = 0.0_rb
+         clrdrad(lay) = 0.0_rb
+         totuclfl(lay) = 0.0_rb
+         totdclfl(lay) = 0.0_rb
+         if (idrv .eq. 1) then
+            d_urad_dt(lay) = 0.0_rb
+            d_clrurad_dt(lay) = 0.0_rb
+            dtotuflux_dt(lay) = 0.0_rb
+            dtotuclfl_dt(lay) = 0.0_rb
+         endif
+
+         do ib = 1, ncbands
+            if (cldfrac(lay) .ge. 1.e-6_rb) then
+               odcld(lay,ib) = secdiff(ib) * taucloud(lay,ib)
+               icldlyr(lay) = 1
+            else
+               odcld(lay,ib) = 0.0_rb
+               icldlyr(lay) = 0
+            endif
+         enddo
+      enddo
+
+! Maximum/Random cloud overlap parameter
+
+      istcld(1) = 1
+      istcldd(nlayers) = 1
+      do lev = 1, nlayers
+
+         if (icldlyr(lev).eq.1) then
+! Maximum/random cloud overlap
+            istcld(lev+1) = 0
+            if (lev .eq. nlayers) then
+               faccld1(lev+1) = 0._rb
+               faccld2(lev+1) = 0._rb
+               facclr1(lev+1) = 0._rb
+               facclr2(lev+1) = 0._rb
+               faccmb1(lev+1) = 0._rb
+               faccmb2(lev+1) = 0._rb
+            elseif (cldfrac(lev+1) .ge. cldfrac(lev)) then
+               faccld1(lev+1) = 0._rb
+               faccld2(lev+1) = 0._rb
+               if (istcld(lev) .eq. 1) then
+                  facclr1(lev+1) = 0._rb
+                  facclr2(lev+1) = 0._rb
+                  if (cldfrac(lev) .lt. 1._rb) facclr2(lev+1) = &
+                     (cldfrac(lev+1)-cldfrac(lev))/(1._rb-cldfrac(lev))
+                  facclr2(lev) = 0._rb
+                  faccld2(lev) = 0._rb
+               else
+                  fmax = max(cldfrac(lev),cldfrac(lev-1))
+                  if (cldfrac(lev+1) .gt. fmax) then
+                     facclr1(lev+1) = rat2
+                     facclr2(lev+1) = (cldfrac(lev+1)-fmax)/(1._rb-fmax)
+                  elseif (cldfrac(lev+1) .lt. fmax) then
+                     facclr1(lev+1) = (cldfrac(lev+1)-cldfrac(lev))/ &
+                        (cldfrac(lev-1)-cldfrac(lev))
+                     facclr2(lev+1) = 0._rb
+                  else
+                     facclr1(lev+1) = rat2
+                     facclr2(lev+1) = 0._rb
+                  endif
+               endif
+               if (facclr1(lev+1).gt.0._rb .or. facclr2(lev+1).gt.0._rb) then
+                  rat1 = 1._rb
+                  rat2 = 0._rb
+               else
+                  rat1 = 0._rb
+                  rat2 = 0._rb
+               endif
+            else
+               facclr1(lev+1) = 0._rb
+               facclr2(lev+1) = 0._rb
+               if (istcld(lev) .eq. 1) then
+                  faccld1(lev+1) = 0._rb
+                  faccld2(lev+1) = (cldfrac(lev)-cldfrac(lev+1))/cldfrac(lev)
+
+                  facclr2(lev) = 0._rb
+                  faccld2(lev) = 0._rb
+               else
+                  fmin = min(cldfrac(lev),cldfrac(lev-1))
+                  if (cldfrac(lev+1) .le. fmin) then
+                     faccld1(lev+1) = rat1
+                     faccld2(lev+1) = (fmin-cldfrac(lev+1))/fmin
+                  else
+                     faccld1(lev+1) = (cldfrac(lev)-cldfrac(lev+1))/(cldfrac(lev)-fmin)
+                     faccld2(lev+1) = 0._rb
+                  endif
+               endif
+               if (faccld1(lev+1).gt.0._rb .or. faccld2(lev+1).gt.0._rb) then
+                  rat1 = 0._rb
+                  rat2 = 1._rb
+               else
+                  rat1 = 0._rb
+                  rat2 = 0._rb
+               endif
+            endif
+            faccmb1(lev+1) = facclr1(lev+1) * faccld2(lev) * cldfrac(lev-1) 
+            faccmb2(lev+1) = faccld1(lev+1) * facclr2(lev) * (1._rb - cldfrac(lev-1)) 
+         else
+            istcld(lev+1) = 1
+         endif
+      enddo
+
+      do lev = nlayers, 1, -1
+         if (icldlyr(lev).eq.1) then
+            istcldd(lev-1) = 0
+            if (lev .eq. 1) then
+               faccld1d(lev-1) = 0._rb
+               faccld2d(lev-1) = 0._rb
+               facclr1d(lev-1) = 0._rb
+               facclr2d(lev-1) = 0._rb
+               faccmb1d(lev-1) = 0._rb
+               faccmb2d(lev-1) = 0._rb
+            elseif (cldfrac(lev-1) .ge. cldfrac(lev)) then
+               faccld1d(lev-1) = 0._rb
+               faccld2d(lev-1) = 0._rb
+               if (istcldd(lev) .eq. 1) then
+                  facclr1d(lev-1) = 0._rb
+                  facclr2d(lev-1) = 0._rb
+                  if (cldfrac(lev) .lt. 1._rb) facclr2d(lev-1) = &
+                     (cldfrac(lev-1)-cldfrac(lev))/(1._rb-cldfrac(lev))
+                  facclr2d(lev) = 0._rb
+                  faccld2d(lev) = 0._rb
+               else
+                  fmax = max(cldfrac(lev),cldfrac(lev+1))
+                  if (cldfrac(lev-1) .gt. fmax) then
+                     facclr1d(lev-1) = rat2
+                     facclr2d(lev-1) = (cldfrac(lev-1)-fmax)/(1._rb-fmax)
+                  elseif (cldfrac(lev-1) .lt. fmax) then
+                     facclr1d(lev-1) = (cldfrac(lev-1)-cldfrac(lev))/ &
+                        (cldfrac(lev+1)-cldfrac(lev))
+                     facclr2d(lev-1) = 0.
+                  else
+                     facclr1d(lev-1) = rat2
+                     facclr2d(lev-1) = 0._rb
+                  endif
+               endif
+               if (facclr1d(lev-1).gt.0._rb .or. facclr2d(lev-1).gt.0._rb)then
+                  rat1 = 1._rb
+                  rat2 = 0._rb
+               else
+                  rat1 = 0._rb
+                  rat2 = 0._rb
+               endif
+            else
+               facclr1d(lev-1) = 0._rb
+               facclr2d(lev-1) = 0._rb
+               if (istcldd(lev) .eq. 1) then
+                  faccld1d(lev-1) = 0._rb
+                  faccld2d(lev-1) = (cldfrac(lev)-cldfrac(lev-1))/cldfrac(lev)
+                  facclr2d(lev) = 0._rb
+                  faccld2d(lev) = 0._rb
+               else
+                  fmin = min(cldfrac(lev),cldfrac(lev+1))
+                  if (cldfrac(lev-1) .le. fmin) then
+                     faccld1d(lev-1) = rat1
+                     faccld2d(lev-1) = (fmin-cldfrac(lev-1))/fmin
+                  else
+                     faccld1d(lev-1) = (cldfrac(lev)-cldfrac(lev-1))/(cldfrac(lev)-fmin)
+                     faccld2d(lev-1) = 0._rb
+                  endif
+               endif
+               if (faccld1d(lev-1).gt.0._rb .or. faccld2d(lev-1).gt.0._rb)then
+                  rat1 = 0._rb
+                  rat2 = 1._rb
+               else
+                  rat1 = 0._rb
+                  rat2 = 0._rb
+               endif
+            endif
+            faccmb1d(lev-1) = facclr1d(lev-1) * faccld2d(lev) * cldfrac(lev+1) 
+            faccmb2d(lev-1) = faccld1d(lev-1) * facclr2d(lev) * (1._rb - cldfrac(lev+1))
+         else
+            istcldd(lev-1) = 1
+         endif
+      enddo
+
+      igc = 1
+! Loop over frequency bands.
+      do iband = istart, iend
+
+! Reinitialize g-point counter for each band if output for each band is requested.
+         if (iout.gt.0.and.iband.ge.2) igc = ngs(iband-1)+1
+         if (ncbands .eq. 1) then
+            ib = ipat(iband,0)
+         elseif (ncbands .eq.  5) then
+            ib = ipat(iband,1)
+         elseif (ncbands .eq. 16) then
+            ib = ipat(iband,2)
+         endif
+
+! Loop over g-channels.
+ 1000    continue
+
+! Radiative transfer starts here.
+         radld = 0._rb
+         radclrd = 0._rb
+         iclddn = 0
+
+! Downward radiative transfer loop.  
+
+         do lev = nlayers, 1, -1
+               plfrac = fracs(lev,igc)
+               blay = planklay(lev,iband)
+               dplankup = planklev(lev,iband) - blay
+               dplankdn = planklev(lev-1,iband) - blay
+               odepth = secdiff(iband) * taut(lev,igc)
+
+               if (odepth .lt. 0.0_rb) odepth = 0.0_rb
+! Cloudy layer
+               if (icldlyr(lev).eq.1) then
+                  iclddn = 1
+                  odtot = odepth + odcld(lev,ib)
+                  if (odtot .lt. 0.06_rb) then
+                     atrans(lev) = odepth - 0.5_rb*odepth*odepth
+                     odepth_rec = rec_6*odepth
+                     gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev)
+
+                     atot(lev) =  odtot - 0.5_rb*odtot*odtot
+                     odtot_rec = rec_6*odtot
+                     bbdtot =  plfrac * (blay+dplankdn*odtot_rec)
+                     bbd = plfrac*(blay+dplankdn*odepth_rec)
+                  
+                     bbugas(lev) =  plfrac * (blay+dplankup*odepth_rec)
+                     bbutot(lev) =  plfrac * (blay+dplankup*odtot_rec)
+                  elseif (odepth .le. 0.06_rb) then
+                     atrans(lev) = odepth - 0.5_rb*odepth*odepth
+                     odepth_rec = rec_6*odepth
+                     gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev)
+
+                     odtot = odepth + odcld(lev,ib)
+                     tblind = odtot/(bpade+odtot)
+                     ittot = tblint*tblind + 0.5_rb
+                     tfactot = tfn_tbl(ittot)
+                     bbdtot = plfrac * (blay + tfactot*dplankdn)
+                     bbd = plfrac*(blay+dplankdn*odepth_rec)
+                     atot(lev) = 1._rb - exp_tbl(ittot)
+
+                     bbugas(lev) = plfrac * (blay + dplankup*odepth_rec)
+                     bbutot(lev) = plfrac * (blay + tfactot * dplankup)
+                  else
+                     tblind = odepth/(bpade+odepth)
+                     itgas = tblint*tblind+0.5_rb
+                     odepth = tau_tbl(itgas)
+                     atrans(lev) = 1._rb - exp_tbl(itgas)
+                     tfacgas = tfn_tbl(itgas)
+                     gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn)
+
+                     odtot = odepth + odcld(lev,ib)
+                     tblind = odtot/(bpade+odtot)
+                     ittot = tblint*tblind + 0.5_rb
+                     tfactot = tfn_tbl(ittot)
+                     bbdtot = plfrac * (blay + tfactot*dplankdn)
+                     bbd = plfrac*(blay+tfacgas*dplankdn)
+                     atot(lev) = 1._rb - exp_tbl(ittot)
+
+                     bbugas(lev) = plfrac * (blay + tfacgas * dplankup)
+                     bbutot(lev) = plfrac * (blay + tfactot * dplankup)
+                  endif
+
+                  if (istcldd(lev) .eq. 1) then
+                     cldradd = cldfrac(lev) * radld
+                     clrradd = radld - cldradd
+                     oldcld = cldradd
+                     oldclr = clrradd
+                     rad = 0._rb
+                  endif
+                  ttot = 1._rb - atot(lev)
+                  cldsrc = bbdtot * atot(lev)
+                  cldradd = cldradd * ttot + cldfrac(lev) * cldsrc
+                  clrradd = clrradd * (1._rb-atrans(lev)) + (1._rb - cldfrac(lev)) * gassrc
+                  radld = cldradd + clrradd
+                  drad(lev-1) = drad(lev-1) + radld
+
+                  radmod = rad * &
+                       (facclr1d(lev-1) * (1.-atrans(lev)) + &
+                       faccld1d(lev-1) *  ttot) - &
+                       faccmb1d(lev-1) * gassrc + &
+                       faccmb2d(lev-1) * cldsrc
+
+                  oldcld = cldradd - radmod
+                  oldclr = clrradd + radmod
+                  rad = -radmod + facclr2d(lev-1)*oldclr - faccld2d(lev-1)*oldcld
+                  cldradd = cldradd + rad
+                  clrradd = clrradd - rad
+! Clear layer
+               else
+                  if (odepth .le. 0.06_rb) then
+                     atrans(lev) = odepth-0.5_rb*odepth*odepth
+                     odepth = rec_6*odepth
+                     bbd = plfrac*(blay+dplankdn*odepth)
+                     bbugas(lev) = plfrac*(blay+dplankup*odepth)
+                  else
+                     tblind = odepth/(bpade+odepth)
+                     itr = tblint*tblind+0.5_rb
+                     transc = exp_tbl(itr)
+                     atrans(lev) = 1._rb-transc
+                     tausfac = tfn_tbl(itr)
+                     bbd = plfrac*(blay+tausfac*dplankdn)
+                     bbugas(lev) = plfrac * (blay + tausfac * dplankup)
+                  endif   
+                  radld = radld + (bbd-radld)*atrans(lev)
+                  drad(lev-1) = drad(lev-1) + radld
+                endif
+!  Set clear sky stream to total sky stream as long as layers
+!  remain clear.  Streams diverge when a cloud is reached (iclddn=1),
+!  and clear sky stream must be computed separately from that point.
+                 if (iclddn.eq.1) then
+                     radclrd = radclrd + (bbd-radclrd) * atrans(lev) 
+                     clrdrad(lev-1) = clrdrad(lev-1) + radclrd
+                  else
+                     radclrd = radld
+                     clrdrad(lev-1) = drad(lev-1)
+                  endif
+            enddo
+
+! Spectral emissivity & reflectance
+!  Include the contribution of spectrally varying longwave emissivity
+!  and reflection from the surface to the upward radiative transfer.
+!  Note: Spectral and Lambertian reflection are identical for the
+!  diffusivity angle flux integration used here.
+!  Note: The emissivity is applied to plankbnd and dplankbnd_dt when 
+!  they are defined in subroutine setcoef. 
+
+         rad0 = fracs(1,igc) * plankbnd(iband)
+         if (idrv .eq. 1) then
+            d_rad0_dt = fracs(1,igc) * dplankbnd_dt(iband)
+         endif
+
+!  Add in reflection of surface downward radiance.
+         reflect = 1._rb - semiss(iband)
+         radlu = rad0 + reflect * radld
+         radclru = rad0 + reflect * radclrd
+
+! Upward radiative transfer loop.
+
+         urad(0) = urad(0) + radlu
+         clrurad(0) = clrurad(0) + radclru
+         if (idrv .eq. 1) then
+            d_radlu_dt = d_rad0_dt
+            d_urad_dt(0) = d_urad_dt(0) + d_radlu_dt
+            d_radclru_dt = d_rad0_dt
+            d_clrurad_dt(0) = d_clrurad_dt(0) + d_radclru_dt
+         endif
+
+         do lev = 1, nlayers
+! Cloudy layer
+            if (icldlyr(lev) .eq. 1) then
+               gassrc = bbugas(lev) * atrans(lev)
+               if (istcld(lev) .eq. 1) then
+                  cldradu = cldfrac(lev) * radlu
+                  clrradu = radlu - cldradu
+                  oldcld = cldradu
+                  oldclr = clrradu
+                  rad = 0._rb
+               endif
+               ttot = 1._rb - atot(lev)
+               cldsrc = bbutot(lev) * atot(lev)
+               cldradu = cldradu * ttot + cldfrac(lev) * cldsrc
+               clrradu = clrradu * (1.0_rb-atrans(lev)) + (1._rb - cldfrac(lev)) * gassrc
+! Total sky radiance
+               radlu = cldradu + clrradu
+               urad(lev) = urad(lev) + radlu
+               radmod = rad * &
+                   (facclr1(lev+1)*(1.0_rb-atrans(lev))+ &
+                   faccld1(lev+1) *  ttot) - &
+                   faccmb1(lev+1) * gassrc + &
+                   faccmb2(lev+1) * cldsrc
+               oldcld = cldradu - radmod
+               oldclr = clrradu + radmod
+               rad = -radmod + facclr2(lev+1)*oldclr - faccld2(lev+1)*oldcld
+               cldradu = cldradu + rad
+               clrradu = clrradu - rad
+               if (idrv .eq. 1) then
+                  d_radlu_dt = d_radlu_dt * cldfrac(lev) * (1.0_rb - atot(lev)) + &
+                         d_radlu_dt * (1.0_rb - cldfrac(lev)) * (1.0_rb - atrans(lev))
+                  d_urad_dt(lev) = d_urad_dt(lev) + d_radlu_dt
+               endif
+! Clear layer
+            else
+               radlu = radlu + (bbugas(lev)-radlu)*atrans(lev)
+               urad(lev) = urad(lev) + radlu
+               if (idrv .eq. 1) then
+                  d_radlu_dt = d_radlu_dt * (1.0_rb - atrans(lev))
+                  d_urad_dt(lev) = d_urad_dt(lev) + d_radlu_dt
+               endif
+            endif
+!  Set clear sky stream to total sky stream as long as all layers
+!  are clear (iclddn=0).  Streams must be calculated separately at 
+!  all layers when a cloud is present (iclddn=1), because surface 
+!  reflectance is different for each stream.
+               if (iclddn.eq.1) then
+                  radclru = radclru + (bbugas(lev)-radclru)*atrans(lev) 
+                  clrurad(lev) = clrurad(lev) + radclru
+               else
+                  radclru = radlu
+                  clrurad(lev) = urad(lev)
+               endif
+               if (idrv .eq. 1) then
+                  if (iclddn.eq.1) then
+                     d_radclru_dt = d_radclru_dt * (1.0_rb - atrans(lev))
+                     d_clrurad_dt(lev) = d_clrurad_dt(lev) + d_radclru_dt
+                  else
+                     d_radclru_dt = d_radlu_dt
+                     d_clrurad_dt(lev) = d_urad_dt(lev)
+                  endif
+               endif
+         enddo
+
+! Increment g-point counter
+         igc = igc + 1
+! Return to continue radiative transfer for all g-channels in present band
+         if (igc .le. ngs(iband)) go to 1000
+
+! Process longwave output from band.
+! Calculate upward, downward, and net flux.
+         do lev = nlayers, 0, -1
+            uflux(lev) = urad(lev)*wtdiff
+            dflux(lev) = drad(lev)*wtdiff
+            urad(lev) = 0.0_rb
+            drad(lev) = 0.0_rb
+            totuflux(lev) = totuflux(lev) + uflux(lev) * delwave(iband)
+            totdflux(lev) = totdflux(lev) + dflux(lev) * delwave(iband)
+            uclfl(lev) = clrurad(lev)*wtdiff
+            dclfl(lev) = clrdrad(lev)*wtdiff
+            clrurad(lev) = 0.0_rb
+            clrdrad(lev) = 0.0_rb
+            totuclfl(lev) = totuclfl(lev) + uclfl(lev) * delwave(iband)
+            totdclfl(lev) = totdclfl(lev) + dclfl(lev) * delwave(iband)
+         enddo
+
+! Calculate total change in upward flux wrt surface temperature
+         if (idrv .eq. 1) then
+            do lev = nlayers, 0, -1
+               duflux_dt(lev) = d_urad_dt(lev) * wtdiff
+               d_urad_dt(lev) = 0.0_rb
+               dtotuflux_dt(lev) = dtotuflux_dt(lev) + duflux_dt(lev) * delwave(iband) * fluxfac
+
+               duclfl_dt(lev) = d_clrurad_dt(lev) * wtdiff
+               d_clrurad_dt(lev) = 0.0_rb
+               dtotuclfl_dt(lev) = dtotuclfl_dt(lev) + duclfl_dt(lev) * delwave(iband) * fluxfac
+            enddo
+         endif
+
+! End spectral band loop
+      enddo
+
+! Calculate fluxes at surface
+      totuflux(0) = totuflux(0) * fluxfac
+      totdflux(0) = totdflux(0) * fluxfac
+      fnet(0) = totuflux(0) - totdflux(0)
+
+      totuclfl(0) = totuclfl(0) * fluxfac
+      totdclfl(0) = totdclfl(0) * fluxfac
+      fnetc(0) = totuclfl(0) - totdclfl(0)
+
+! Calculate fluxes at model levels
+      do lev = 1, nlayers
+         totuflux(lev) = totuflux(lev) * fluxfac
+         totdflux(lev) = totdflux(lev) * fluxfac
+         fnet(lev) = totuflux(lev) - totdflux(lev)
+         totuclfl(lev) = totuclfl(lev) * fluxfac
+         totdclfl(lev) = totdclfl(lev) * fluxfac
+         fnetc(lev) = totuclfl(lev) - totdclfl(lev)
+         l = lev - 1
+
+! Calculate heating rates at model layers
+         htr(l)=heatfac*(fnet(l)-fnet(lev))/(pz(l)-pz(lev)) 
+         htrc(l)=heatfac*(fnetc(l)-fnetc(lev))/(pz(l)-pz(lev)) 
+      enddo
+
+! Set heating rate to zero in top layer
+      htr(nlayers) = 0.0_rb
+      htrc(nlayers) = 0.0_rb
+
+      end subroutine rtrnmr
+
+      end module rrtmg_lw_rtrnmr
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_setcoef.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_setcoef.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_setcoef.f90	(revision 1585)
@@ -0,0 +1,1993 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_setcoef.f90,v $
+!     author:    $Author: miacono $
+!     revision:  $Revision: 1.6 $
+!     created:   $Date: 2011/04/08 20:25:01 $
+!
+      module rrtmg_lw_setcoef
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrtm, only : nbndlw, mg, maxxsec, mxmol
+      use rrlw_wvn, only: totplnk, totplk16, totplnkderiv, totplk16deriv
+      use rrlw_ref
+      use rrlw_vsn, only: hvrset, hnamset
+
+      implicit none
+
+      contains
+
+!----------------------------------------------------------------------------
+      subroutine setcoef(nlayers, istart, pavel, tavel, tz, tbound, semiss, &
+                         coldry, wkl, wbroad, &
+                         laytrop, jp, jt, jt1, planklay, planklev, plankbnd, &
+                         idrv, dplankbnd_dt, &
+                         colh2o, colco2, colo3, coln2o, colco, colch4, colo2, &
+                         colbrd, fac00, fac01, fac10, fac11, &
+                         rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, &
+                         rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, &
+                         rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, &
+                         selffac, selffrac, indself, forfac, forfrac, indfor, &
+                         minorfrac, scaleminor, scaleminorn2, indminor)
+!----------------------------------------------------------------------------
+!
+!  Purpose:  For a given atmosphere, calculate the indices and
+!  fractions related to the pressure and temperature interpolations.
+!  Also calculate the values of the integrated Planck functions 
+!  for each band at the level and layer temperatures.
+
+! ------- Declarations -------
+
+! ----- Input -----
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: istart          ! beginning band of calculation
+      integer(kind=im), intent(in) :: idrv            ! Planck derivative option flag
+
+      real(kind=rb), intent(in) :: pavel(:)           ! layer pressures (mb) 
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tavel(:)           ! layer temperatures (K)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tz(0:)             ! level (interface) temperatures (K)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tbound             ! surface temperature (K)
+      real(kind=rb), intent(in) :: coldry(:)          ! dry air column density (mol/cm2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: wbroad(:)          ! broadening gas column density (mol/cm2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: wkl(:,:)           ! molecular amounts (mol/cm-2)
+                                                      !    Dimensions: (mxmol,nlayers)
+      real(kind=rb), intent(in) :: semiss(:)          ! lw surface emissivity
+                                                      !    Dimensions: (nbndlw)
+
+! ----- Output -----
+      integer(kind=im), intent(out) :: laytrop        ! tropopause layer index
+      integer(kind=im), intent(out) :: jp(:)          ! 
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(out) :: jt(:)          !
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(out) :: jt1(:)         !
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: planklay(:,:)     ! 
+                                                      !    Dimensions: (nlayers,nbndlw)
+      real(kind=rb), intent(out) :: planklev(0:,:)    ! 
+                                                      !    Dimensions: (0:nlayers,nbndlw)
+      real(kind=rb), intent(out) :: plankbnd(:)       ! 
+                                                      !    Dimensions: (nbndlw)
+      real(kind=rb), intent(out) :: dplankbnd_dt(:)   ! 
+                                                      !    Dimensions: (nbndlw)
+
+      real(kind=rb), intent(out) :: colh2o(:)         ! column amount (h2o)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colco2(:)         ! column amount (co2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colo3(:)          ! column amount (o3)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: coln2o(:)         ! column amount (n2o)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colco(:)          ! column amount (co)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colch4(:)         ! column amount (ch4)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colo2(:)          ! column amount (o2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colbrd(:)         ! column amount (broadening gases)
+                                                      !    Dimensions: (nlayers)
+
+      integer(kind=im), intent(out) :: indself(:)
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(out) :: indfor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: selffac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: selffrac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: forfac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: forfrac(:)
+                                                      !    Dimensions: (nlayers)
+
+      integer(kind=im), intent(out) :: indminor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: minorfrac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: scaleminor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: scaleminorn2(:)
+                                                      !    Dimensions: (nlayers)
+
+      real(kind=rb), intent(out) :: &                 !
+                       fac00(:), fac01(:), &          !    Dimensions: (nlayers)
+                       fac10(:), fac11(:) 
+                                                        
+      real(kind=rb), intent(out) :: &                 !
+                       rat_h2oco2(:),rat_h2oco2_1(:), &
+                       rat_h2oo3(:),rat_h2oo3_1(:), & !    Dimensions: (nlayers)
+                       rat_h2on2o(:),rat_h2on2o_1(:), &
+                       rat_h2och4(:),rat_h2och4_1(:), &
+                       rat_n2oco2(:),rat_n2oco2_1(:), &
+                       rat_o3co2(:),rat_o3co2_1(:)
+                                                        
+
+! ----- Local -----
+      integer(kind=im) :: indbound, indlev0
+      integer(kind=im) :: lay, indlay, indlev, iband
+      integer(kind=im) :: jp1
+      real(kind=rb) :: stpfac, tbndfrac, t0frac, tlayfrac, tlevfrac
+      real(kind=rb) :: dbdtlev, dbdtlay
+      real(kind=rb) :: plog, fp, ft, ft1, water, scalefac, factor, compfp
+
+
+      hvrset = '$Revision: 1.6 $'
+
+      stpfac = 296._rb/1013._rb
+
+      indbound = tbound - 159._rb
+      if (indbound .lt. 1) then
+         indbound = 1
+      elseif (indbound .gt. 180) then
+         indbound = 180
+      endif
+      tbndfrac = tbound - 159._rb - real(indbound)
+      indlev0 = tz(0) - 159._rb
+      if (indlev0 .lt. 1) then
+         indlev0 = 1
+      elseif (indlev0 .gt. 180) then
+         indlev0 = 180
+      endif
+      t0frac = tz(0) - 159._rb - real(indlev0)
+      laytrop = 0
+
+! Begin layer loop 
+!  Calculate the integrated Planck functions for each band at the
+!  surface, level, and layer temperatures.
+      do lay = 1, nlayers
+         indlay = tavel(lay) - 159._rb
+         if (indlay .lt. 1) then
+            indlay = 1
+         elseif (indlay .gt. 180) then
+            indlay = 180
+         endif
+         tlayfrac = tavel(lay) - 159._rb - real(indlay)
+         indlev = tz(lay) - 159._rb
+         if (indlev .lt. 1) then
+            indlev = 1
+         elseif (indlev .gt. 180) then
+            indlev = 180
+         endif
+         tlevfrac = tz(lay) - 159._rb - real(indlev)
+
+! Begin spectral band loop 
+         do iband = 1, 15
+            if (lay.eq.1) then
+               dbdtlev = totplnk(indbound+1,iband) - totplnk(indbound,iband)
+               plankbnd(iband) = semiss(iband) * &
+                   (totplnk(indbound,iband) + tbndfrac * dbdtlev)
+               dbdtlev = totplnk(indlev0+1,iband)-totplnk(indlev0,iband)
+               planklev(0,iband) = totplnk(indlev0,iband) + t0frac * dbdtlev
+               if (idrv .eq. 1) then 
+                  dbdtlev = totplnkderiv(indbound+1,iband) - totplnkderiv(indbound,iband)
+                  dplankbnd_dt(iband) = semiss(iband) * &
+                      (totplnkderiv(indbound,iband) + tbndfrac * dbdtlev)
+               endif
+            endif
+            dbdtlev = totplnk(indlev+1,iband) - totplnk(indlev,iband)
+            dbdtlay = totplnk(indlay+1,iband) - totplnk(indlay,iband)
+            planklay(lay,iband) = totplnk(indlay,iband) + tlayfrac * dbdtlay
+            planklev(lay,iband) = totplnk(indlev,iband) + tlevfrac * dbdtlev
+         enddo
+
+!  For band 16, if radiative transfer will be performed on just
+!  this band, use integrated Planck values up to 3250 cm-1.  
+!  If radiative transfer will be performed across all 16 bands,
+!  then include in the integrated Planck values for this band
+!  contributions from 2600 cm-1 to infinity.
+         iband = 16
+         if (istart .eq. 16) then
+            if (lay.eq.1) then
+               dbdtlev = totplk16(indbound+1) - totplk16(indbound)
+               plankbnd(iband) = semiss(iband) * &
+                    (totplk16(indbound) + tbndfrac * dbdtlev)
+               if (idrv .eq. 1) then
+                  dbdtlev = totplk16deriv(indbound+1) - totplk16deriv(indbound)
+                  dplankbnd_dt(iband) = semiss(iband) * &
+                       (totplk16deriv(indbound) + tbndfrac * dbdtlev)
+               endif
+               dbdtlev = totplnk(indlev0+1,iband)-totplnk(indlev0,iband)
+               planklev(0,iband) = totplk16(indlev0) + &
+                    t0frac * dbdtlev
+            endif
+            dbdtlev = totplk16(indlev+1) - totplk16(indlev)
+            dbdtlay = totplk16(indlay+1) - totplk16(indlay)
+            planklay(lay,iband) = totplk16(indlay) + tlayfrac * dbdtlay
+            planklev(lay,iband) = totplk16(indlev) + tlevfrac * dbdtlev
+         else
+            if (lay.eq.1) then
+               dbdtlev = totplnk(indbound+1,iband) - totplnk(indbound,iband)
+               plankbnd(iband) = semiss(iband) * &
+                    (totplnk(indbound,iband) + tbndfrac * dbdtlev)
+               if (idrv .eq. 1) then 
+                  dbdtlev = totplnkderiv(indbound+1,iband) - totplnkderiv(indbound,iband)
+                  dplankbnd_dt(iband) = semiss(iband) * &
+                       (totplnkderiv(indbound,iband) + tbndfrac * dbdtlev)
+               endif
+               dbdtlev = totplnk(indlev0+1,iband)-totplnk(indlev0,iband)
+               planklev(0,iband) = totplnk(indlev0,iband) + t0frac * dbdtlev
+            endif
+            dbdtlev = totplnk(indlev+1,iband) - totplnk(indlev,iband)
+            dbdtlay = totplnk(indlay+1,iband) - totplnk(indlay,iband)
+            planklay(lay,iband) = totplnk(indlay,iband) + tlayfrac * dbdtlay
+            planklev(lay,iband) = totplnk(indlev,iband) + tlevfrac * dbdtlev
+         endif
+
+!  Find the two reference pressures on either side of the
+!  layer pressure.  Store them in JP and JP1.  Store in FP the
+!  fraction of the difference (in ln(pressure)) between these
+!  two values that the layer pressure lies.
+!         plog = alog(pavel(lay))
+         plog = dlog(pavel(lay))
+         jp(lay) = int(36._rb - 5*(plog+0.04_rb))
+         if (jp(lay) .lt. 1) then
+            jp(lay) = 1
+         elseif (jp(lay) .gt. 58) then
+            jp(lay) = 58
+         endif
+         jp1 = jp(lay) + 1
+         fp = 5._rb *(preflog(jp(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(lay) = int(3._rb + (tavel(lay)-tref(jp(lay)))/15._rb)
+         if (jt(lay) .lt. 1) then
+            jt(lay) = 1
+         elseif (jt(lay) .gt. 4) then
+            jt(lay) = 4
+         endif
+         ft = ((tavel(lay)-tref(jp(lay)))/15._rb) - real(jt(lay)-3)
+         jt1(lay) = int(3._rb + (tavel(lay)-tref(jp1))/15._rb)
+         if (jt1(lay) .lt. 1) then
+            jt1(lay) = 1
+         elseif (jt1(lay) .gt. 4) then
+            jt1(lay) = 4
+         endif
+         ft1 = ((tavel(lay)-tref(jp1))/15._rb) - real(jt1(lay)-3)
+         water = wkl(1,lay)/coldry(lay)
+         scalefac = pavel(lay) * stpfac / tavel(lay)
+
+!  If the pressure is less than ~100mb, perform a different
+!  set of species interpolations.
+         if (plog .le. 4.56_rb) go to 5300
+         laytrop =  laytrop + 1
+
+         forfac(lay) = scalefac / (1.+water)
+         factor = (332.0_rb-tavel(lay))/36.0_rb
+         indfor(lay) = min(2, max(1, int(factor)))
+         forfrac(lay) = factor - real(indfor(lay))
+
+!  Set up factors needed to separately include the water vapor
+!  self-continuum in the calculation of absorption coefficient.
+         selffac(lay) = water * forfac(lay)
+         factor = (tavel(lay)-188.0_rb)/7.2_rb
+         indself(lay) = min(9, max(1, int(factor)-7))
+         selffrac(lay) = factor - real(indself(lay) + 7)
+
+!  Set up factors needed to separately include the minor gases
+!  in the calculation of absorption coefficient
+         scaleminor(lay) = pavel(lay)/tavel(lay)
+         scaleminorn2(lay) = (pavel(lay)/tavel(lay)) &
+             *(wbroad(lay)/(coldry(lay)+wkl(1,lay)))
+         factor = (tavel(lay)-180.8_rb)/7.2_rb
+         indminor(lay) = min(18, max(1, int(factor)))
+         minorfrac(lay) = factor - real(indminor(lay))
+
+!  Setup reference ratio to be used in calculation of binary
+!  species parameter in lower atmosphere.
+         rat_h2oco2(lay)=chi_mls(1,jp(lay))/chi_mls(2,jp(lay))
+         rat_h2oco2_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(2,jp(lay)+1)
+
+         rat_h2oo3(lay)=chi_mls(1,jp(lay))/chi_mls(3,jp(lay))
+         rat_h2oo3_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(3,jp(lay)+1)
+
+         rat_h2on2o(lay)=chi_mls(1,jp(lay))/chi_mls(4,jp(lay))
+         rat_h2on2o_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(4,jp(lay)+1)
+
+         rat_h2och4(lay)=chi_mls(1,jp(lay))/chi_mls(6,jp(lay))
+         rat_h2och4_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(6,jp(lay)+1)
+
+         rat_n2oco2(lay)=chi_mls(4,jp(lay))/chi_mls(2,jp(lay))
+         rat_n2oco2_1(lay)=chi_mls(4,jp(lay)+1)/chi_mls(2,jp(lay)+1)
+
+!  Calculate needed column amounts.
+         colh2o(lay) = 1.e-20_rb * wkl(1,lay)
+         colco2(lay) = 1.e-20_rb * wkl(2,lay)
+         colo3(lay) = 1.e-20_rb * wkl(3,lay)
+         coln2o(lay) = 1.e-20_rb * wkl(4,lay)
+         colco(lay) = 1.e-20_rb * wkl(5,lay)
+         colch4(lay) = 1.e-20_rb * wkl(6,lay)
+         colo2(lay) = 1.e-20_rb * wkl(7,lay)
+         if (colco2(lay) .eq. 0._rb) colco2(lay) = 1.e-32_rb * coldry(lay)
+         if (colo3(lay) .eq. 0._rb) colo3(lay) = 1.e-32_rb * coldry(lay)
+         if (coln2o(lay) .eq. 0._rb) coln2o(lay) = 1.e-32_rb * coldry(lay)
+         if (colco(lay) .eq. 0._rb) colco(lay) = 1.e-32_rb * coldry(lay)
+         if (colch4(lay) .eq. 0._rb) colch4(lay) = 1.e-32_rb * coldry(lay)
+         colbrd(lay) = 1.e-20_rb * wbroad(lay)
+         go to 5400
+
+!  Above laytrop.
+ 5300    continue
+
+         forfac(lay) = scalefac / (1.+water)
+         factor = (tavel(lay)-188.0_rb)/36.0_rb
+         indfor(lay) = 3
+         forfrac(lay) = factor - 1.0_rb
+
+!  Set up factors needed to separately include the water vapor
+!  self-continuum in the calculation of absorption coefficient.
+         selffac(lay) = water * forfac(lay)
+
+!  Set up factors needed to separately include the minor gases
+!  in the calculation of absorption coefficient
+         scaleminor(lay) = pavel(lay)/tavel(lay)         
+         scaleminorn2(lay) = (pavel(lay)/tavel(lay)) &
+             * (wbroad(lay)/(coldry(lay)+wkl(1,lay)))
+         factor = (tavel(lay)-180.8_rb)/7.2_rb
+         indminor(lay) = min(18, max(1, int(factor)))
+         minorfrac(lay) = factor - real(indminor(lay))
+
+!  Setup reference ratio to be used in calculation of binary
+!  species parameter in upper atmosphere.
+         rat_h2oco2(lay)=chi_mls(1,jp(lay))/chi_mls(2,jp(lay))
+         rat_h2oco2_1(lay)=chi_mls(1,jp(lay)+1)/chi_mls(2,jp(lay)+1)         
+
+         rat_o3co2(lay)=chi_mls(3,jp(lay))/chi_mls(2,jp(lay))
+         rat_o3co2_1(lay)=chi_mls(3,jp(lay)+1)/chi_mls(2,jp(lay)+1)         
+
+!  Calculate needed column amounts.
+         colh2o(lay) = 1.e-20_rb * wkl(1,lay)
+         colco2(lay) = 1.e-20_rb * wkl(2,lay)
+         colo3(lay) = 1.e-20_rb * wkl(3,lay)
+         coln2o(lay) = 1.e-20_rb * wkl(4,lay)
+         colco(lay) = 1.e-20_rb * wkl(5,lay)
+         colch4(lay) = 1.e-20_rb * wkl(6,lay)
+         colo2(lay) = 1.e-20_rb * wkl(7,lay)
+         if (colco2(lay) .eq. 0._rb) colco2(lay) = 1.e-32_rb * coldry(lay)
+         if (colo3(lay) .eq. 0._rb) colo3(lay) = 1.e-32_rb * coldry(lay)
+         if (coln2o(lay) .eq. 0._rb) coln2o(lay) = 1.e-32_rb * coldry(lay)
+         if (colco(lay)  .eq. 0._rb) colco(lay) = 1.e-32_rb * coldry(lay)
+         if (colch4(lay) .eq. 0._rb) colch4(lay) = 1.e-32_rb * coldry(lay)
+         colbrd(lay) = 1.e-20_rb * wbroad(lay)
+ 5400    continue
+
+!  We have now isolated the layer ln pressure and temperature,
+!  between two reference pressures and two reference temperatures 
+!  (for each reference pressure).  We multiply the pressure 
+!  fraction FP with the appropriate temperature fractions to get 
+!  the factors that will be needed for the interpolation that yields
+!  the optical depths (performed in routines TAUGBn for band n).`
+
+         compfp = 1. - fp
+         fac10(lay) = compfp * ft
+         fac00(lay) = compfp * (1._rb - ft)
+         fac11(lay) = fp * ft1
+         fac01(lay) = fp * (1._rb - ft1)
+
+!  Rescale selffac and forfac for use in taumol
+         selffac(lay) = colh2o(lay)*selffac(lay)
+         forfac(lay) = colh2o(lay)*forfac(lay)
+
+! End layer loop
+      enddo
+
+      end subroutine setcoef
+
+!***************************************************************************
+      subroutine lwatmref
+!***************************************************************************
+
+      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_rb,8.62642e+02_rb,7.06272e+02_rb,5.78246e+02_rb,4.73428e+02_rb, &
+          3.87610e+02_rb,3.17348e+02_rb,2.59823e+02_rb,2.12725e+02_rb,1.74164e+02_rb, &
+          1.42594e+02_rb,1.16746e+02_rb,9.55835e+01_rb,7.82571e+01_rb,6.40715e+01_rb, &
+          5.24573e+01_rb,4.29484e+01_rb,3.51632e+01_rb,2.87892e+01_rb,2.35706e+01_rb, &
+          1.92980e+01_rb,1.57998e+01_rb,1.29358e+01_rb,1.05910e+01_rb,8.67114e+00_rb, &
+          7.09933e+00_rb,5.81244e+00_rb,4.75882e+00_rb,3.89619e+00_rb,3.18993e+00_rb, &
+          2.61170e+00_rb,2.13828e+00_rb,1.75067e+00_rb,1.43333e+00_rb,1.17351e+00_rb, &
+          9.60789e-01_rb,7.86628e-01_rb,6.44036e-01_rb,5.27292e-01_rb,4.31710e-01_rb, &
+          3.53455e-01_rb,2.89384e-01_rb,2.36928e-01_rb,1.93980e-01_rb,1.58817e-01_rb, &
+          1.30029e-01_rb,1.06458e-01_rb,8.71608e-02_rb,7.13612e-02_rb,5.84256e-02_rb, &
+          4.78349e-02_rb,3.91639e-02_rb,3.20647e-02_rb,2.62523e-02_rb,2.14936e-02_rb, &
+          1.75975e-02_rb,1.44076e-02_rb,1.17959e-02_rb,9.65769e-03_rb/)
+
+      preflog(:) = (/ &
+           6.9600e+00_rb, 6.7600e+00_rb, 6.5600e+00_rb, 6.3600e+00_rb, 6.1600e+00_rb, &
+           5.9600e+00_rb, 5.7600e+00_rb, 5.5600e+00_rb, 5.3600e+00_rb, 5.1600e+00_rb, &
+           4.9600e+00_rb, 4.7600e+00_rb, 4.5600e+00_rb, 4.3600e+00_rb, 4.1600e+00_rb, &
+           3.9600e+00_rb, 3.7600e+00_rb, 3.5600e+00_rb, 3.3600e+00_rb, 3.1600e+00_rb, &
+           2.9600e+00_rb, 2.7600e+00_rb, 2.5600e+00_rb, 2.3600e+00_rb, 2.1600e+00_rb, &
+           1.9600e+00_rb, 1.7600e+00_rb, 1.5600e+00_rb, 1.3600e+00_rb, 1.1600e+00_rb, &
+           9.6000e-01_rb, 7.6000e-01_rb, 5.6000e-01_rb, 3.6000e-01_rb, 1.6000e-01_rb, &
+          -4.0000e-02_rb,-2.4000e-01_rb,-4.4000e-01_rb,-6.4000e-01_rb,-8.4000e-01_rb, &
+          -1.0400e+00_rb,-1.2400e+00_rb,-1.4400e+00_rb,-1.6400e+00_rb,-1.8400e+00_rb, &
+          -2.0400e+00_rb,-2.2400e+00_rb,-2.4400e+00_rb,-2.6400e+00_rb,-2.8400e+00_rb, &
+          -3.0400e+00_rb,-3.2400e+00_rb,-3.4400e+00_rb,-3.6400e+00_rb,-3.8400e+00_rb, &
+          -4.0400e+00_rb,-4.2400e+00_rb,-4.4400e+00_rb,-4.6400e+00_rb/)
+
+! These are the temperatures associated with the respective 
+! pressures for the mls standard atmosphere. 
+
+      tref(:) = (/ &
+           2.9420e+02_rb, 2.8799e+02_rb, 2.7894e+02_rb, 2.6925e+02_rb, 2.5983e+02_rb, &
+           2.5017e+02_rb, 2.4077e+02_rb, 2.3179e+02_rb, 2.2306e+02_rb, 2.1578e+02_rb, &
+           2.1570e+02_rb, 2.1570e+02_rb, 2.1570e+02_rb, 2.1706e+02_rb, 2.1858e+02_rb, &
+           2.2018e+02_rb, 2.2174e+02_rb, 2.2328e+02_rb, 2.2479e+02_rb, 2.2655e+02_rb, &
+           2.2834e+02_rb, 2.3113e+02_rb, 2.3401e+02_rb, 2.3703e+02_rb, 2.4022e+02_rb, &
+           2.4371e+02_rb, 2.4726e+02_rb, 2.5085e+02_rb, 2.5457e+02_rb, 2.5832e+02_rb, &
+           2.6216e+02_rb, 2.6606e+02_rb, 2.6999e+02_rb, 2.7340e+02_rb, 2.7536e+02_rb, &
+           2.7568e+02_rb, 2.7372e+02_rb, 2.7163e+02_rb, 2.6955e+02_rb, 2.6593e+02_rb, &
+           2.6211e+02_rb, 2.5828e+02_rb, 2.5360e+02_rb, 2.4854e+02_rb, 2.4348e+02_rb, &
+           2.3809e+02_rb, 2.3206e+02_rb, 2.2603e+02_rb, 2.2000e+02_rb, 2.1435e+02_rb, &
+           2.0887e+02_rb, 2.0340e+02_rb, 1.9792e+02_rb, 1.9290e+02_rb, 1.8809e+02_rb, &
+           1.8329e+02_rb, 1.7849e+02_rb, 1.7394e+02_rb, 1.7212e+02_rb/)
+
+       chi_mls(1,1:12) = (/ &
+        1.8760e-02_rb, 1.2223e-02_rb, 5.8909e-03_rb, 2.7675e-03_rb, 1.4065e-03_rb, &
+        7.5970e-04_rb, 3.8876e-04_rb, 1.6542e-04_rb, 3.7190e-05_rb, 7.4765e-06_rb, &
+        4.3082e-06_rb, 3.3319e-06_rb/)
+       chi_mls(1,13:59) = (/ &
+        3.2039e-06_rb,  3.1619e-06_rb,  3.2524e-06_rb,  3.4226e-06_rb,  3.6288e-06_rb, &
+        3.9148e-06_rb,  4.1488e-06_rb,  4.3081e-06_rb,  4.4420e-06_rb,  4.5778e-06_rb, &
+        4.7087e-06_rb,  4.7943e-06_rb,  4.8697e-06_rb,  4.9260e-06_rb,  4.9669e-06_rb, &
+        4.9963e-06_rb,  5.0527e-06_rb,  5.1266e-06_rb,  5.2503e-06_rb,  5.3571e-06_rb, &
+        5.4509e-06_rb,  5.4830e-06_rb,  5.5000e-06_rb,  5.5000e-06_rb,  5.4536e-06_rb, &
+        5.4047e-06_rb,  5.3558e-06_rb,  5.2533e-06_rb,  5.1436e-06_rb,  5.0340e-06_rb, &
+        4.8766e-06_rb,  4.6979e-06_rb,  4.5191e-06_rb,  4.3360e-06_rb,  4.1442e-06_rb, &
+        3.9523e-06_rb,  3.7605e-06_rb,  3.5722e-06_rb,  3.3855e-06_rb,  3.1988e-06_rb, &
+        3.0121e-06_rb,  2.8262e-06_rb,  2.6407e-06_rb,  2.4552e-06_rb,  2.2696e-06_rb, &
+        4.3360e-06_rb,  4.1442e-06_rb/)
+       chi_mls(2,1:12) = (/ &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb/)
+       chi_mls(2,13:59) = (/ &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb,  3.5500e-04_rb, &
+        3.5500e-04_rb,  3.5471e-04_rb,  3.5427e-04_rb,  3.5384e-04_rb,  3.5340e-04_rb, &
+        3.5500e-04_rb,  3.5500e-04_rb/)
+       chi_mls(3,1:12) = (/ &
+        3.0170e-08_rb,  3.4725e-08_rb,  4.2477e-08_rb,  5.2759e-08_rb,  6.6944e-08_rb, &
+        8.7130e-08_rb,  1.1391e-07_rb,  1.5677e-07_rb,  2.1788e-07_rb,  3.2443e-07_rb, &
+        4.6594e-07_rb,  5.6806e-07_rb/)
+       chi_mls(3,13:59) = (/ &
+        6.9607e-07_rb,  1.1186e-06_rb,  1.7618e-06_rb,  2.3269e-06_rb,  2.9577e-06_rb, &
+        3.6593e-06_rb,  4.5950e-06_rb,  5.3189e-06_rb,  5.9618e-06_rb,  6.5113e-06_rb, &
+        7.0635e-06_rb,  7.6917e-06_rb,  8.2577e-06_rb,  8.7082e-06_rb,  8.8325e-06_rb, &
+        8.7149e-06_rb,  8.0943e-06_rb,  7.3307e-06_rb,  6.3101e-06_rb,  5.3672e-06_rb, &
+        4.4829e-06_rb,  3.8391e-06_rb,  3.2827e-06_rb,  2.8235e-06_rb,  2.4906e-06_rb, &
+        2.1645e-06_rb,  1.8385e-06_rb,  1.6618e-06_rb,  1.5052e-06_rb,  1.3485e-06_rb, &
+        1.1972e-06_rb,  1.0482e-06_rb,  8.9926e-07_rb,  7.6343e-07_rb,  6.5381e-07_rb, &
+        5.4419e-07_rb,  4.3456e-07_rb,  3.6421e-07_rb,  3.1194e-07_rb,  2.5967e-07_rb, &
+        2.0740e-07_rb,  1.9146e-07_rb,  1.9364e-07_rb,  1.9582e-07_rb,  1.9800e-07_rb, &
+        7.6343e-07_rb,  6.5381e-07_rb/)
+       chi_mls(4,1:12) = (/ &
+        3.2000e-07_rb,  3.2000e-07_rb,  3.2000e-07_rb,  3.2000e-07_rb,  3.2000e-07_rb, &
+        3.1965e-07_rb,  3.1532e-07_rb,  3.0383e-07_rb,  2.9422e-07_rb,  2.8495e-07_rb, &
+        2.7671e-07_rb,  2.6471e-07_rb/)
+       chi_mls(4,13:59) = (/ &
+        2.4285e-07_rb,  2.0955e-07_rb,  1.7195e-07_rb,  1.3749e-07_rb,  1.1332e-07_rb, &
+        1.0035e-07_rb,  9.1281e-08_rb,  8.5463e-08_rb,  8.0363e-08_rb,  7.3372e-08_rb, &
+        6.5975e-08_rb,  5.6039e-08_rb,  4.7090e-08_rb,  3.9977e-08_rb,  3.2979e-08_rb, &
+        2.6064e-08_rb,  2.1066e-08_rb,  1.6592e-08_rb,  1.3017e-08_rb,  1.0090e-08_rb, &
+        7.6249e-09_rb,  6.1159e-09_rb,  4.6672e-09_rb,  3.2857e-09_rb,  2.8484e-09_rb, &
+        2.4620e-09_rb,  2.0756e-09_rb,  1.8551e-09_rb,  1.6568e-09_rb,  1.4584e-09_rb, &
+        1.3195e-09_rb,  1.2072e-09_rb,  1.0948e-09_rb,  9.9780e-10_rb,  9.3126e-10_rb, &
+        8.6472e-10_rb,  7.9818e-10_rb,  7.5138e-10_rb,  7.1367e-10_rb,  6.7596e-10_rb, &
+        6.3825e-10_rb,  6.0981e-10_rb,  5.8600e-10_rb,  5.6218e-10_rb,  5.3837e-10_rb, &
+        9.9780e-10_rb,  9.3126e-10_rb/)
+       chi_mls(5,1:12) = (/ &
+        1.5000e-07_rb,  1.4306e-07_rb,  1.3474e-07_rb,  1.3061e-07_rb,  1.2793e-07_rb, &
+        1.2038e-07_rb,  1.0798e-07_rb,  9.4238e-08_rb,  7.9488e-08_rb,  6.1386e-08_rb, &
+        4.5563e-08_rb,  3.3475e-08_rb/)
+       chi_mls(5,13:59) = (/ &
+        2.5118e-08_rb,  1.8671e-08_rb,  1.4349e-08_rb,  1.2501e-08_rb,  1.2407e-08_rb, &
+        1.3472e-08_rb,  1.4900e-08_rb,  1.6079e-08_rb,  1.7156e-08_rb,  1.8616e-08_rb, &
+        2.0106e-08_rb,  2.1654e-08_rb,  2.3096e-08_rb,  2.4340e-08_rb,  2.5643e-08_rb, &
+        2.6990e-08_rb,  2.8456e-08_rb,  2.9854e-08_rb,  3.0943e-08_rb,  3.2023e-08_rb, &
+        3.3101e-08_rb,  3.4260e-08_rb,  3.5360e-08_rb,  3.6397e-08_rb,  3.7310e-08_rb, &
+        3.8217e-08_rb,  3.9123e-08_rb,  4.1303e-08_rb,  4.3652e-08_rb,  4.6002e-08_rb, &
+        5.0289e-08_rb,  5.5446e-08_rb,  6.0603e-08_rb,  6.8946e-08_rb,  8.3652e-08_rb, &
+        9.8357e-08_rb,  1.1306e-07_rb,  1.4766e-07_rb,  1.9142e-07_rb,  2.3518e-07_rb, &
+        2.7894e-07_rb,  3.5001e-07_rb,  4.3469e-07_rb,  5.1938e-07_rb,  6.0407e-07_rb, &
+        6.8946e-08_rb,  8.3652e-08_rb/)
+       chi_mls(6,1:12) = (/ &
+        1.7000e-06_rb,  1.7000e-06_rb,  1.6999e-06_rb,  1.6904e-06_rb,  1.6671e-06_rb, &
+        1.6351e-06_rb,  1.6098e-06_rb,  1.5590e-06_rb,  1.5120e-06_rb,  1.4741e-06_rb, &
+        1.4385e-06_rb,  1.4002e-06_rb/)
+       chi_mls(6,13:59) = (/ &
+        1.3573e-06_rb,  1.3130e-06_rb,  1.2512e-06_rb,  1.1668e-06_rb,  1.0553e-06_rb, &
+        9.3281e-07_rb,  8.1217e-07_rb,  7.5239e-07_rb,  7.0728e-07_rb,  6.6722e-07_rb, &
+        6.2733e-07_rb,  5.8604e-07_rb,  5.4769e-07_rb,  5.1480e-07_rb,  4.8206e-07_rb, &
+        4.4943e-07_rb,  4.1702e-07_rb,  3.8460e-07_rb,  3.5200e-07_rb,  3.1926e-07_rb, &
+        2.8646e-07_rb,  2.5498e-07_rb,  2.2474e-07_rb,  1.9588e-07_rb,  1.8295e-07_rb, &
+        1.7089e-07_rb,  1.5882e-07_rb,  1.5536e-07_rb,  1.5304e-07_rb,  1.5072e-07_rb, &
+        1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb, &
+        1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb, &
+        1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb,  1.5000e-07_rb, &
+        1.5000e-07_rb,  1.5000e-07_rb/)
+       chi_mls(7,1:12) = (/ &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb/)
+       chi_mls(7,13:59) = (/ &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb,  0.2090_rb, &
+        0.2090_rb,  0.2090_rb/)
+
+      end subroutine lwatmref
+
+!***************************************************************************
+      subroutine lwavplank
+!***************************************************************************
+
+      save
+ 
+      totplnk(1:50,  1) = (/ &
+      0.14783e-05_rb,0.15006e-05_rb,0.15230e-05_rb,0.15455e-05_rb,0.15681e-05_rb, &
+      0.15908e-05_rb,0.16136e-05_rb,0.16365e-05_rb,0.16595e-05_rb,0.16826e-05_rb, &
+      0.17059e-05_rb,0.17292e-05_rb,0.17526e-05_rb,0.17762e-05_rb,0.17998e-05_rb, &
+      0.18235e-05_rb,0.18473e-05_rb,0.18712e-05_rb,0.18953e-05_rb,0.19194e-05_rb, &
+      0.19435e-05_rb,0.19678e-05_rb,0.19922e-05_rb,0.20166e-05_rb,0.20412e-05_rb, &
+      0.20658e-05_rb,0.20905e-05_rb,0.21153e-05_rb,0.21402e-05_rb,0.21652e-05_rb, &
+      0.21902e-05_rb,0.22154e-05_rb,0.22406e-05_rb,0.22659e-05_rb,0.22912e-05_rb, &
+      0.23167e-05_rb,0.23422e-05_rb,0.23678e-05_rb,0.23934e-05_rb,0.24192e-05_rb, &
+      0.24450e-05_rb,0.24709e-05_rb,0.24968e-05_rb,0.25229e-05_rb,0.25490e-05_rb, &
+      0.25751e-05_rb,0.26014e-05_rb,0.26277e-05_rb,0.26540e-05_rb,0.26805e-05_rb/)
+      totplnk(51:100,  1) = (/ &
+      0.27070e-05_rb,0.27335e-05_rb,0.27602e-05_rb,0.27869e-05_rb,0.28136e-05_rb, &
+      0.28404e-05_rb,0.28673e-05_rb,0.28943e-05_rb,0.29213e-05_rb,0.29483e-05_rb, &
+      0.29754e-05_rb,0.30026e-05_rb,0.30298e-05_rb,0.30571e-05_rb,0.30845e-05_rb, &
+      0.31119e-05_rb,0.31393e-05_rb,0.31669e-05_rb,0.31944e-05_rb,0.32220e-05_rb, &
+      0.32497e-05_rb,0.32774e-05_rb,0.33052e-05_rb,0.33330e-05_rb,0.33609e-05_rb, &
+      0.33888e-05_rb,0.34168e-05_rb,0.34448e-05_rb,0.34729e-05_rb,0.35010e-05_rb, &
+      0.35292e-05_rb,0.35574e-05_rb,0.35857e-05_rb,0.36140e-05_rb,0.36424e-05_rb, &
+      0.36708e-05_rb,0.36992e-05_rb,0.37277e-05_rb,0.37563e-05_rb,0.37848e-05_rb, &
+      0.38135e-05_rb,0.38421e-05_rb,0.38708e-05_rb,0.38996e-05_rb,0.39284e-05_rb, &
+      0.39572e-05_rb,0.39861e-05_rb,0.40150e-05_rb,0.40440e-05_rb,0.40730e-05_rb/)
+      totplnk(101:150,  1) = (/ &
+      0.41020e-05_rb,0.41311e-05_rb,0.41602e-05_rb,0.41893e-05_rb,0.42185e-05_rb, &
+      0.42477e-05_rb,0.42770e-05_rb,0.43063e-05_rb,0.43356e-05_rb,0.43650e-05_rb, &
+      0.43944e-05_rb,0.44238e-05_rb,0.44533e-05_rb,0.44828e-05_rb,0.45124e-05_rb, &
+      0.45419e-05_rb,0.45715e-05_rb,0.46012e-05_rb,0.46309e-05_rb,0.46606e-05_rb, &
+      0.46903e-05_rb,0.47201e-05_rb,0.47499e-05_rb,0.47797e-05_rb,0.48096e-05_rb, &
+      0.48395e-05_rb,0.48695e-05_rb,0.48994e-05_rb,0.49294e-05_rb,0.49594e-05_rb, &
+      0.49895e-05_rb,0.50196e-05_rb,0.50497e-05_rb,0.50798e-05_rb,0.51100e-05_rb, &
+      0.51402e-05_rb,0.51704e-05_rb,0.52007e-05_rb,0.52309e-05_rb,0.52612e-05_rb, &
+      0.52916e-05_rb,0.53219e-05_rb,0.53523e-05_rb,0.53827e-05_rb,0.54132e-05_rb, &
+      0.54436e-05_rb,0.54741e-05_rb,0.55047e-05_rb,0.55352e-05_rb,0.55658e-05_rb/)
+      totplnk(151:181,  1) = (/ &
+      0.55964e-05_rb,0.56270e-05_rb,0.56576e-05_rb,0.56883e-05_rb,0.57190e-05_rb, &
+      0.57497e-05_rb,0.57804e-05_rb,0.58112e-05_rb,0.58420e-05_rb,0.58728e-05_rb, &
+      0.59036e-05_rb,0.59345e-05_rb,0.59653e-05_rb,0.59962e-05_rb,0.60272e-05_rb, &
+      0.60581e-05_rb,0.60891e-05_rb,0.61201e-05_rb,0.61511e-05_rb,0.61821e-05_rb, &
+      0.62131e-05_rb,0.62442e-05_rb,0.62753e-05_rb,0.63064e-05_rb,0.63376e-05_rb, &
+      0.63687e-05_rb,0.63998e-05_rb,0.64310e-05_rb,0.64622e-05_rb,0.64935e-05_rb, &
+      0.65247e-05_rb/)
+      totplnk(1:50,  2) = (/ &
+      0.20262e-05_rb,0.20757e-05_rb,0.21257e-05_rb,0.21763e-05_rb,0.22276e-05_rb, &
+      0.22794e-05_rb,0.23319e-05_rb,0.23849e-05_rb,0.24386e-05_rb,0.24928e-05_rb, &
+      0.25477e-05_rb,0.26031e-05_rb,0.26591e-05_rb,0.27157e-05_rb,0.27728e-05_rb, &
+      0.28306e-05_rb,0.28889e-05_rb,0.29478e-05_rb,0.30073e-05_rb,0.30673e-05_rb, &
+      0.31279e-05_rb,0.31890e-05_rb,0.32507e-05_rb,0.33129e-05_rb,0.33757e-05_rb, &
+      0.34391e-05_rb,0.35029e-05_rb,0.35674e-05_rb,0.36323e-05_rb,0.36978e-05_rb, &
+      0.37638e-05_rb,0.38304e-05_rb,0.38974e-05_rb,0.39650e-05_rb,0.40331e-05_rb, &
+      0.41017e-05_rb,0.41708e-05_rb,0.42405e-05_rb,0.43106e-05_rb,0.43812e-05_rb, &
+      0.44524e-05_rb,0.45240e-05_rb,0.45961e-05_rb,0.46687e-05_rb,0.47418e-05_rb, &
+      0.48153e-05_rb,0.48894e-05_rb,0.49639e-05_rb,0.50389e-05_rb,0.51143e-05_rb/)
+      totplnk(51:100,  2) = (/ &
+      0.51902e-05_rb,0.52666e-05_rb,0.53434e-05_rb,0.54207e-05_rb,0.54985e-05_rb, &
+      0.55767e-05_rb,0.56553e-05_rb,0.57343e-05_rb,0.58139e-05_rb,0.58938e-05_rb, &
+      0.59742e-05_rb,0.60550e-05_rb,0.61362e-05_rb,0.62179e-05_rb,0.63000e-05_rb, &
+      0.63825e-05_rb,0.64654e-05_rb,0.65487e-05_rb,0.66324e-05_rb,0.67166e-05_rb, &
+      0.68011e-05_rb,0.68860e-05_rb,0.69714e-05_rb,0.70571e-05_rb,0.71432e-05_rb, &
+      0.72297e-05_rb,0.73166e-05_rb,0.74039e-05_rb,0.74915e-05_rb,0.75796e-05_rb, &
+      0.76680e-05_rb,0.77567e-05_rb,0.78459e-05_rb,0.79354e-05_rb,0.80252e-05_rb, &
+      0.81155e-05_rb,0.82061e-05_rb,0.82970e-05_rb,0.83883e-05_rb,0.84799e-05_rb, &
+      0.85719e-05_rb,0.86643e-05_rb,0.87569e-05_rb,0.88499e-05_rb,0.89433e-05_rb, &
+      0.90370e-05_rb,0.91310e-05_rb,0.92254e-05_rb,0.93200e-05_rb,0.94150e-05_rb/)
+      totplnk(101:150,  2) = (/ &
+      0.95104e-05_rb,0.96060e-05_rb,0.97020e-05_rb,0.97982e-05_rb,0.98948e-05_rb, &
+      0.99917e-05_rb,0.10089e-04_rb,0.10186e-04_rb,0.10284e-04_rb,0.10382e-04_rb, &
+      0.10481e-04_rb,0.10580e-04_rb,0.10679e-04_rb,0.10778e-04_rb,0.10877e-04_rb, &
+      0.10977e-04_rb,0.11077e-04_rb,0.11178e-04_rb,0.11279e-04_rb,0.11380e-04_rb, &
+      0.11481e-04_rb,0.11583e-04_rb,0.11684e-04_rb,0.11786e-04_rb,0.11889e-04_rb, &
+      0.11992e-04_rb,0.12094e-04_rb,0.12198e-04_rb,0.12301e-04_rb,0.12405e-04_rb, &
+      0.12509e-04_rb,0.12613e-04_rb,0.12717e-04_rb,0.12822e-04_rb,0.12927e-04_rb, &
+      0.13032e-04_rb,0.13138e-04_rb,0.13244e-04_rb,0.13349e-04_rb,0.13456e-04_rb, &
+      0.13562e-04_rb,0.13669e-04_rb,0.13776e-04_rb,0.13883e-04_rb,0.13990e-04_rb, &
+      0.14098e-04_rb,0.14206e-04_rb,0.14314e-04_rb,0.14422e-04_rb,0.14531e-04_rb/)
+      totplnk(151:181,  2) = (/ &
+      0.14639e-04_rb,0.14748e-04_rb,0.14857e-04_rb,0.14967e-04_rb,0.15076e-04_rb, &
+      0.15186e-04_rb,0.15296e-04_rb,0.15407e-04_rb,0.15517e-04_rb,0.15628e-04_rb, &
+      0.15739e-04_rb,0.15850e-04_rb,0.15961e-04_rb,0.16072e-04_rb,0.16184e-04_rb, &
+      0.16296e-04_rb,0.16408e-04_rb,0.16521e-04_rb,0.16633e-04_rb,0.16746e-04_rb, &
+      0.16859e-04_rb,0.16972e-04_rb,0.17085e-04_rb,0.17198e-04_rb,0.17312e-04_rb, &
+      0.17426e-04_rb,0.17540e-04_rb,0.17654e-04_rb,0.17769e-04_rb,0.17883e-04_rb, &
+      0.17998e-04_rb/)
+      totplnk(1:50, 3) = (/ &
+      1.34822e-06_rb,1.39134e-06_rb,1.43530e-06_rb,1.48010e-06_rb,1.52574e-06_rb, &
+      1.57222e-06_rb,1.61956e-06_rb,1.66774e-06_rb,1.71678e-06_rb,1.76666e-06_rb, &
+      1.81741e-06_rb,1.86901e-06_rb,1.92147e-06_rb,1.97479e-06_rb,2.02898e-06_rb, &
+      2.08402e-06_rb,2.13993e-06_rb,2.19671e-06_rb,2.25435e-06_rb,2.31285e-06_rb, &
+      2.37222e-06_rb,2.43246e-06_rb,2.49356e-06_rb,2.55553e-06_rb,2.61837e-06_rb, &
+      2.68207e-06_rb,2.74664e-06_rb,2.81207e-06_rb,2.87837e-06_rb,2.94554e-06_rb, &
+      3.01356e-06_rb,3.08245e-06_rb,3.15221e-06_rb,3.22282e-06_rb,3.29429e-06_rb, &
+      3.36662e-06_rb,3.43982e-06_rb,3.51386e-06_rb,3.58876e-06_rb,3.66451e-06_rb, &
+      3.74112e-06_rb,3.81857e-06_rb,3.89688e-06_rb,3.97602e-06_rb,4.05601e-06_rb, &
+      4.13685e-06_rb,4.21852e-06_rb,4.30104e-06_rb,4.38438e-06_rb,4.46857e-06_rb/)
+      totplnk(51:100, 3) = (/ &
+      4.55358e-06_rb,4.63943e-06_rb,4.72610e-06_rb,4.81359e-06_rb,4.90191e-06_rb, &
+      4.99105e-06_rb,5.08100e-06_rb,5.17176e-06_rb,5.26335e-06_rb,5.35573e-06_rb, &
+      5.44892e-06_rb,5.54292e-06_rb,5.63772e-06_rb,5.73331e-06_rb,5.82970e-06_rb, &
+      5.92688e-06_rb,6.02485e-06_rb,6.12360e-06_rb,6.22314e-06_rb,6.32346e-06_rb, &
+      6.42455e-06_rb,6.52641e-06_rb,6.62906e-06_rb,6.73247e-06_rb,6.83664e-06_rb, &
+      6.94156e-06_rb,7.04725e-06_rb,7.15370e-06_rb,7.26089e-06_rb,7.36883e-06_rb, &
+      7.47752e-06_rb,7.58695e-06_rb,7.69712e-06_rb,7.80801e-06_rb,7.91965e-06_rb, &
+      8.03201e-06_rb,8.14510e-06_rb,8.25891e-06_rb,8.37343e-06_rb,8.48867e-06_rb, &
+      8.60463e-06_rb,8.72128e-06_rb,8.83865e-06_rb,8.95672e-06_rb,9.07548e-06_rb, &
+      9.19495e-06_rb,9.31510e-06_rb,9.43594e-06_rb,9.55745e-06_rb,9.67966e-06_rb/)
+      totplnk(101:150, 3) = (/ &
+      9.80254e-06_rb,9.92609e-06_rb,1.00503e-05_rb,1.01752e-05_rb,1.03008e-05_rb, &
+      1.04270e-05_rb,1.05539e-05_rb,1.06814e-05_rb,1.08096e-05_rb,1.09384e-05_rb, &
+      1.10679e-05_rb,1.11980e-05_rb,1.13288e-05_rb,1.14601e-05_rb,1.15922e-05_rb, &
+      1.17248e-05_rb,1.18581e-05_rb,1.19920e-05_rb,1.21265e-05_rb,1.22616e-05_rb, &
+      1.23973e-05_rb,1.25337e-05_rb,1.26706e-05_rb,1.28081e-05_rb,1.29463e-05_rb, &
+      1.30850e-05_rb,1.32243e-05_rb,1.33642e-05_rb,1.35047e-05_rb,1.36458e-05_rb, &
+      1.37875e-05_rb,1.39297e-05_rb,1.40725e-05_rb,1.42159e-05_rb,1.43598e-05_rb, &
+      1.45044e-05_rb,1.46494e-05_rb,1.47950e-05_rb,1.49412e-05_rb,1.50879e-05_rb, &
+      1.52352e-05_rb,1.53830e-05_rb,1.55314e-05_rb,1.56803e-05_rb,1.58297e-05_rb, &
+      1.59797e-05_rb,1.61302e-05_rb,1.62812e-05_rb,1.64327e-05_rb,1.65848e-05_rb/)
+      totplnk(151:181, 3) = (/ &
+      1.67374e-05_rb,1.68904e-05_rb,1.70441e-05_rb,1.71982e-05_rb,1.73528e-05_rb, &
+      1.75079e-05_rb,1.76635e-05_rb,1.78197e-05_rb,1.79763e-05_rb,1.81334e-05_rb, &
+      1.82910e-05_rb,1.84491e-05_rb,1.86076e-05_rb,1.87667e-05_rb,1.89262e-05_rb, &
+      1.90862e-05_rb,1.92467e-05_rb,1.94076e-05_rb,1.95690e-05_rb,1.97309e-05_rb, &
+      1.98932e-05_rb,2.00560e-05_rb,2.02193e-05_rb,2.03830e-05_rb,2.05472e-05_rb, &
+      2.07118e-05_rb,2.08768e-05_rb,2.10423e-05_rb,2.12083e-05_rb,2.13747e-05_rb, &
+      2.15414e-05_rb/)
+      totplnk(1:50, 4) = (/ &
+      8.90528e-07_rb,9.24222e-07_rb,9.58757e-07_rb,9.94141e-07_rb,1.03038e-06_rb, &
+      1.06748e-06_rb,1.10545e-06_rb,1.14430e-06_rb,1.18403e-06_rb,1.22465e-06_rb, &
+      1.26618e-06_rb,1.30860e-06_rb,1.35193e-06_rb,1.39619e-06_rb,1.44136e-06_rb, &
+      1.48746e-06_rb,1.53449e-06_rb,1.58246e-06_rb,1.63138e-06_rb,1.68124e-06_rb, &
+      1.73206e-06_rb,1.78383e-06_rb,1.83657e-06_rb,1.89028e-06_rb,1.94495e-06_rb, &
+      2.00060e-06_rb,2.05724e-06_rb,2.11485e-06_rb,2.17344e-06_rb,2.23303e-06_rb, &
+      2.29361e-06_rb,2.35519e-06_rb,2.41777e-06_rb,2.48134e-06_rb,2.54592e-06_rb, &
+      2.61151e-06_rb,2.67810e-06_rb,2.74571e-06_rb,2.81433e-06_rb,2.88396e-06_rb, &
+      2.95461e-06_rb,3.02628e-06_rb,3.09896e-06_rb,3.17267e-06_rb,3.24741e-06_rb, &
+      3.32316e-06_rb,3.39994e-06_rb,3.47774e-06_rb,3.55657e-06_rb,3.63642e-06_rb/)
+      totplnk(51:100, 4) = (/ &
+      3.71731e-06_rb,3.79922e-06_rb,3.88216e-06_rb,3.96612e-06_rb,4.05112e-06_rb, &
+      4.13714e-06_rb,4.22419e-06_rb,4.31227e-06_rb,4.40137e-06_rb,4.49151e-06_rb, &
+      4.58266e-06_rb,4.67485e-06_rb,4.76806e-06_rb,4.86229e-06_rb,4.95754e-06_rb, &
+      5.05383e-06_rb,5.15113e-06_rb,5.24946e-06_rb,5.34879e-06_rb,5.44916e-06_rb, &
+      5.55053e-06_rb,5.65292e-06_rb,5.75632e-06_rb,5.86073e-06_rb,5.96616e-06_rb, &
+      6.07260e-06_rb,6.18003e-06_rb,6.28848e-06_rb,6.39794e-06_rb,6.50838e-06_rb, &
+      6.61983e-06_rb,6.73229e-06_rb,6.84573e-06_rb,6.96016e-06_rb,7.07559e-06_rb, &
+      7.19200e-06_rb,7.30940e-06_rb,7.42779e-06_rb,7.54715e-06_rb,7.66749e-06_rb, &
+      7.78882e-06_rb,7.91110e-06_rb,8.03436e-06_rb,8.15859e-06_rb,8.28379e-06_rb, &
+      8.40994e-06_rb,8.53706e-06_rb,8.66515e-06_rb,8.79418e-06_rb,8.92416e-06_rb/)
+      totplnk(101:150, 4) = (/ &
+      9.05510e-06_rb,9.18697e-06_rb,9.31979e-06_rb,9.45356e-06_rb,9.58826e-06_rb, &
+      9.72389e-06_rb,9.86046e-06_rb,9.99793e-06_rb,1.01364e-05_rb,1.02757e-05_rb, &
+      1.04159e-05_rb,1.05571e-05_rb,1.06992e-05_rb,1.08422e-05_rb,1.09861e-05_rb, &
+      1.11309e-05_rb,1.12766e-05_rb,1.14232e-05_rb,1.15707e-05_rb,1.17190e-05_rb, &
+      1.18683e-05_rb,1.20184e-05_rb,1.21695e-05_rb,1.23214e-05_rb,1.24741e-05_rb, &
+      1.26277e-05_rb,1.27822e-05_rb,1.29376e-05_rb,1.30939e-05_rb,1.32509e-05_rb, &
+      1.34088e-05_rb,1.35676e-05_rb,1.37273e-05_rb,1.38877e-05_rb,1.40490e-05_rb, &
+      1.42112e-05_rb,1.43742e-05_rb,1.45380e-05_rb,1.47026e-05_rb,1.48680e-05_rb, &
+      1.50343e-05_rb,1.52014e-05_rb,1.53692e-05_rb,1.55379e-05_rb,1.57074e-05_rb, &
+      1.58778e-05_rb,1.60488e-05_rb,1.62207e-05_rb,1.63934e-05_rb,1.65669e-05_rb/)
+      totplnk(151:181, 4) = (/ &
+      1.67411e-05_rb,1.69162e-05_rb,1.70920e-05_rb,1.72685e-05_rb,1.74459e-05_rb, &
+      1.76240e-05_rb,1.78029e-05_rb,1.79825e-05_rb,1.81629e-05_rb,1.83440e-05_rb, &
+      1.85259e-05_rb,1.87086e-05_rb,1.88919e-05_rb,1.90760e-05_rb,1.92609e-05_rb, &
+      1.94465e-05_rb,1.96327e-05_rb,1.98199e-05_rb,2.00076e-05_rb,2.01961e-05_rb, &
+      2.03853e-05_rb,2.05752e-05_rb,2.07658e-05_rb,2.09571e-05_rb,2.11491e-05_rb, &
+      2.13418e-05_rb,2.15352e-05_rb,2.17294e-05_rb,2.19241e-05_rb,2.21196e-05_rb, &
+      2.23158e-05_rb/)
+      totplnk(1:50, 5) = (/ &
+      5.70230e-07_rb,5.94788e-07_rb,6.20085e-07_rb,6.46130e-07_rb,6.72936e-07_rb, &
+      7.00512e-07_rb,7.28869e-07_rb,7.58019e-07_rb,7.87971e-07_rb,8.18734e-07_rb, &
+      8.50320e-07_rb,8.82738e-07_rb,9.15999e-07_rb,9.50110e-07_rb,9.85084e-07_rb, &
+      1.02093e-06_rb,1.05765e-06_rb,1.09527e-06_rb,1.13378e-06_rb,1.17320e-06_rb, &
+      1.21353e-06_rb,1.25479e-06_rb,1.29698e-06_rb,1.34011e-06_rb,1.38419e-06_rb, &
+      1.42923e-06_rb,1.47523e-06_rb,1.52221e-06_rb,1.57016e-06_rb,1.61910e-06_rb, &
+      1.66904e-06_rb,1.71997e-06_rb,1.77192e-06_rb,1.82488e-06_rb,1.87886e-06_rb, &
+      1.93387e-06_rb,1.98991e-06_rb,2.04699e-06_rb,2.10512e-06_rb,2.16430e-06_rb, &
+      2.22454e-06_rb,2.28584e-06_rb,2.34821e-06_rb,2.41166e-06_rb,2.47618e-06_rb, &
+      2.54178e-06_rb,2.60847e-06_rb,2.67626e-06_rb,2.74514e-06_rb,2.81512e-06_rb/)
+      totplnk(51:100, 5) = (/ &
+      2.88621e-06_rb,2.95841e-06_rb,3.03172e-06_rb,3.10615e-06_rb,3.18170e-06_rb, &
+      3.25838e-06_rb,3.33618e-06_rb,3.41511e-06_rb,3.49518e-06_rb,3.57639e-06_rb, &
+      3.65873e-06_rb,3.74221e-06_rb,3.82684e-06_rb,3.91262e-06_rb,3.99955e-06_rb, &
+      4.08763e-06_rb,4.17686e-06_rb,4.26725e-06_rb,4.35880e-06_rb,4.45150e-06_rb, &
+      4.54537e-06_rb,4.64039e-06_rb,4.73659e-06_rb,4.83394e-06_rb,4.93246e-06_rb, &
+      5.03215e-06_rb,5.13301e-06_rb,5.23504e-06_rb,5.33823e-06_rb,5.44260e-06_rb, &
+      5.54814e-06_rb,5.65484e-06_rb,5.76272e-06_rb,5.87177e-06_rb,5.98199e-06_rb, &
+      6.09339e-06_rb,6.20596e-06_rb,6.31969e-06_rb,6.43460e-06_rb,6.55068e-06_rb, &
+      6.66793e-06_rb,6.78636e-06_rb,6.90595e-06_rb,7.02670e-06_rb,7.14863e-06_rb, &
+      7.27173e-06_rb,7.39599e-06_rb,7.52142e-06_rb,7.64802e-06_rb,7.77577e-06_rb/)
+      totplnk(101:150, 5) = (/ &
+      7.90469e-06_rb,8.03477e-06_rb,8.16601e-06_rb,8.29841e-06_rb,8.43198e-06_rb, &
+      8.56669e-06_rb,8.70256e-06_rb,8.83957e-06_rb,8.97775e-06_rb,9.11706e-06_rb, &
+      9.25753e-06_rb,9.39915e-06_rb,9.54190e-06_rb,9.68580e-06_rb,9.83085e-06_rb, &
+      9.97704e-06_rb,1.01243e-05_rb,1.02728e-05_rb,1.04224e-05_rb,1.05731e-05_rb, &
+      1.07249e-05_rb,1.08779e-05_rb,1.10320e-05_rb,1.11872e-05_rb,1.13435e-05_rb, &
+      1.15009e-05_rb,1.16595e-05_rb,1.18191e-05_rb,1.19799e-05_rb,1.21418e-05_rb, &
+      1.23048e-05_rb,1.24688e-05_rb,1.26340e-05_rb,1.28003e-05_rb,1.29676e-05_rb, &
+      1.31361e-05_rb,1.33056e-05_rb,1.34762e-05_rb,1.36479e-05_rb,1.38207e-05_rb, &
+      1.39945e-05_rb,1.41694e-05_rb,1.43454e-05_rb,1.45225e-05_rb,1.47006e-05_rb, &
+      1.48797e-05_rb,1.50600e-05_rb,1.52413e-05_rb,1.54236e-05_rb,1.56070e-05_rb/)
+      totplnk(151:181, 5) = (/ &
+      1.57914e-05_rb,1.59768e-05_rb,1.61633e-05_rb,1.63509e-05_rb,1.65394e-05_rb, &
+      1.67290e-05_rb,1.69197e-05_rb,1.71113e-05_rb,1.73040e-05_rb,1.74976e-05_rb, &
+      1.76923e-05_rb,1.78880e-05_rb,1.80847e-05_rb,1.82824e-05_rb,1.84811e-05_rb, &
+      1.86808e-05_rb,1.88814e-05_rb,1.90831e-05_rb,1.92857e-05_rb,1.94894e-05_rb, &
+      1.96940e-05_rb,1.98996e-05_rb,2.01061e-05_rb,2.03136e-05_rb,2.05221e-05_rb, &
+      2.07316e-05_rb,2.09420e-05_rb,2.11533e-05_rb,2.13657e-05_rb,2.15789e-05_rb, &
+      2.17931e-05_rb/)
+      totplnk(1:50, 6) = (/ &
+      2.73493e-07_rb,2.87408e-07_rb,3.01848e-07_rb,3.16825e-07_rb,3.32352e-07_rb, &
+      3.48439e-07_rb,3.65100e-07_rb,3.82346e-07_rb,4.00189e-07_rb,4.18641e-07_rb, &
+      4.37715e-07_rb,4.57422e-07_rb,4.77774e-07_rb,4.98784e-07_rb,5.20464e-07_rb, &
+      5.42824e-07_rb,5.65879e-07_rb,5.89638e-07_rb,6.14115e-07_rb,6.39320e-07_rb, &
+      6.65266e-07_rb,6.91965e-07_rb,7.19427e-07_rb,7.47666e-07_rb,7.76691e-07_rb, &
+      8.06516e-07_rb,8.37151e-07_rb,8.68607e-07_rb,9.00896e-07_rb,9.34029e-07_rb, &
+      9.68018e-07_rb,1.00287e-06_rb,1.03860e-06_rb,1.07522e-06_rb,1.11274e-06_rb, &
+      1.15117e-06_rb,1.19052e-06_rb,1.23079e-06_rb,1.27201e-06_rb,1.31418e-06_rb, &
+      1.35731e-06_rb,1.40141e-06_rb,1.44650e-06_rb,1.49257e-06_rb,1.53965e-06_rb, &
+      1.58773e-06_rb,1.63684e-06_rb,1.68697e-06_rb,1.73815e-06_rb,1.79037e-06_rb/)
+      totplnk(51:100, 6) = (/ &
+      1.84365e-06_rb,1.89799e-06_rb,1.95341e-06_rb,2.00991e-06_rb,2.06750e-06_rb, &
+      2.12619e-06_rb,2.18599e-06_rb,2.24691e-06_rb,2.30895e-06_rb,2.37212e-06_rb, &
+      2.43643e-06_rb,2.50189e-06_rb,2.56851e-06_rb,2.63628e-06_rb,2.70523e-06_rb, &
+      2.77536e-06_rb,2.84666e-06_rb,2.91916e-06_rb,2.99286e-06_rb,3.06776e-06_rb, &
+      3.14387e-06_rb,3.22120e-06_rb,3.29975e-06_rb,3.37953e-06_rb,3.46054e-06_rb, &
+      3.54280e-06_rb,3.62630e-06_rb,3.71105e-06_rb,3.79707e-06_rb,3.88434e-06_rb, &
+      3.97288e-06_rb,4.06270e-06_rb,4.15380e-06_rb,4.24617e-06_rb,4.33984e-06_rb, &
+      4.43479e-06_rb,4.53104e-06_rb,4.62860e-06_rb,4.72746e-06_rb,4.82763e-06_rb, &
+      4.92911e-06_rb,5.03191e-06_rb,5.13603e-06_rb,5.24147e-06_rb,5.34824e-06_rb, &
+      5.45634e-06_rb,5.56578e-06_rb,5.67656e-06_rb,5.78867e-06_rb,5.90213e-06_rb/)
+      totplnk(101:150, 6) = (/ &
+      6.01694e-06_rb,6.13309e-06_rb,6.25060e-06_rb,6.36947e-06_rb,6.48968e-06_rb, &
+      6.61126e-06_rb,6.73420e-06_rb,6.85850e-06_rb,6.98417e-06_rb,7.11120e-06_rb, &
+      7.23961e-06_rb,7.36938e-06_rb,7.50053e-06_rb,7.63305e-06_rb,7.76694e-06_rb, &
+      7.90221e-06_rb,8.03887e-06_rb,8.17690e-06_rb,8.31632e-06_rb,8.45710e-06_rb, &
+      8.59928e-06_rb,8.74282e-06_rb,8.88776e-06_rb,9.03409e-06_rb,9.18179e-06_rb, &
+      9.33088e-06_rb,9.48136e-06_rb,9.63323e-06_rb,9.78648e-06_rb,9.94111e-06_rb, &
+      1.00971e-05_rb,1.02545e-05_rb,1.04133e-05_rb,1.05735e-05_rb,1.07351e-05_rb, &
+      1.08980e-05_rb,1.10624e-05_rb,1.12281e-05_rb,1.13952e-05_rb,1.15637e-05_rb, &
+      1.17335e-05_rb,1.19048e-05_rb,1.20774e-05_rb,1.22514e-05_rb,1.24268e-05_rb, &
+      1.26036e-05_rb,1.27817e-05_rb,1.29612e-05_rb,1.31421e-05_rb,1.33244e-05_rb/)
+      totplnk(151:181, 6) = (/ &
+      1.35080e-05_rb,1.36930e-05_rb,1.38794e-05_rb,1.40672e-05_rb,1.42563e-05_rb, &
+      1.44468e-05_rb,1.46386e-05_rb,1.48318e-05_rb,1.50264e-05_rb,1.52223e-05_rb, &
+      1.54196e-05_rb,1.56182e-05_rb,1.58182e-05_rb,1.60196e-05_rb,1.62223e-05_rb, &
+      1.64263e-05_rb,1.66317e-05_rb,1.68384e-05_rb,1.70465e-05_rb,1.72559e-05_rb, &
+      1.74666e-05_rb,1.76787e-05_rb,1.78921e-05_rb,1.81069e-05_rb,1.83230e-05_rb, &
+      1.85404e-05_rb,1.87591e-05_rb,1.89791e-05_rb,1.92005e-05_rb,1.94232e-05_rb, &
+      1.96471e-05_rb/)
+      totplnk(1:50, 7) = (/ &
+      1.25349e-07_rb,1.32735e-07_rb,1.40458e-07_rb,1.48527e-07_rb,1.56954e-07_rb, &
+      1.65748e-07_rb,1.74920e-07_rb,1.84481e-07_rb,1.94443e-07_rb,2.04814e-07_rb, &
+      2.15608e-07_rb,2.26835e-07_rb,2.38507e-07_rb,2.50634e-07_rb,2.63229e-07_rb, &
+      2.76301e-07_rb,2.89864e-07_rb,3.03930e-07_rb,3.18508e-07_rb,3.33612e-07_rb, &
+      3.49253e-07_rb,3.65443e-07_rb,3.82195e-07_rb,3.99519e-07_rb,4.17428e-07_rb, &
+      4.35934e-07_rb,4.55050e-07_rb,4.74785e-07_rb,4.95155e-07_rb,5.16170e-07_rb, &
+      5.37844e-07_rb,5.60186e-07_rb,5.83211e-07_rb,6.06929e-07_rb,6.31355e-07_rb, &
+      6.56498e-07_rb,6.82373e-07_rb,7.08990e-07_rb,7.36362e-07_rb,7.64501e-07_rb, &
+      7.93420e-07_rb,8.23130e-07_rb,8.53643e-07_rb,8.84971e-07_rb,9.17128e-07_rb, &
+      9.50123e-07_rb,9.83969e-07_rb,1.01868e-06_rb,1.05426e-06_rb,1.09073e-06_rb/)
+      totplnk(51:100, 7) = (/ &
+      1.12810e-06_rb,1.16638e-06_rb,1.20558e-06_rb,1.24572e-06_rb,1.28680e-06_rb, &
+      1.32883e-06_rb,1.37183e-06_rb,1.41581e-06_rb,1.46078e-06_rb,1.50675e-06_rb, &
+      1.55374e-06_rb,1.60174e-06_rb,1.65078e-06_rb,1.70087e-06_rb,1.75200e-06_rb, &
+      1.80421e-06_rb,1.85749e-06_rb,1.91186e-06_rb,1.96732e-06_rb,2.02389e-06_rb, &
+      2.08159e-06_rb,2.14040e-06_rb,2.20035e-06_rb,2.26146e-06_rb,2.32372e-06_rb, &
+      2.38714e-06_rb,2.45174e-06_rb,2.51753e-06_rb,2.58451e-06_rb,2.65270e-06_rb, &
+      2.72210e-06_rb,2.79272e-06_rb,2.86457e-06_rb,2.93767e-06_rb,3.01201e-06_rb, &
+      3.08761e-06_rb,3.16448e-06_rb,3.24261e-06_rb,3.32204e-06_rb,3.40275e-06_rb, &
+      3.48476e-06_rb,3.56808e-06_rb,3.65271e-06_rb,3.73866e-06_rb,3.82595e-06_rb, &
+      3.91456e-06_rb,4.00453e-06_rb,4.09584e-06_rb,4.18851e-06_rb,4.28254e-06_rb/)
+      totplnk(101:150, 7) = (/ &
+      4.37796e-06_rb,4.47475e-06_rb,4.57293e-06_rb,4.67249e-06_rb,4.77346e-06_rb, &
+      4.87583e-06_rb,4.97961e-06_rb,5.08481e-06_rb,5.19143e-06_rb,5.29948e-06_rb, &
+      5.40896e-06_rb,5.51989e-06_rb,5.63226e-06_rb,5.74608e-06_rb,5.86136e-06_rb, &
+      5.97810e-06_rb,6.09631e-06_rb,6.21597e-06_rb,6.33713e-06_rb,6.45976e-06_rb, &
+      6.58388e-06_rb,6.70950e-06_rb,6.83661e-06_rb,6.96521e-06_rb,7.09531e-06_rb, &
+      7.22692e-06_rb,7.36005e-06_rb,7.49468e-06_rb,7.63084e-06_rb,7.76851e-06_rb, &
+      7.90773e-06_rb,8.04846e-06_rb,8.19072e-06_rb,8.33452e-06_rb,8.47985e-06_rb, &
+      8.62674e-06_rb,8.77517e-06_rb,8.92514e-06_rb,9.07666e-06_rb,9.22975e-06_rb, &
+      9.38437e-06_rb,9.54057e-06_rb,9.69832e-06_rb,9.85762e-06_rb,1.00185e-05_rb, &
+      1.01810e-05_rb,1.03450e-05_rb,1.05106e-05_rb,1.06777e-05_rb,1.08465e-05_rb/)
+      totplnk(151:181, 7) = (/ &
+      1.10168e-05_rb,1.11887e-05_rb,1.13621e-05_rb,1.15372e-05_rb,1.17138e-05_rb, &
+      1.18920e-05_rb,1.20718e-05_rb,1.22532e-05_rb,1.24362e-05_rb,1.26207e-05_rb, &
+      1.28069e-05_rb,1.29946e-05_rb,1.31839e-05_rb,1.33749e-05_rb,1.35674e-05_rb, &
+      1.37615e-05_rb,1.39572e-05_rb,1.41544e-05_rb,1.43533e-05_rb,1.45538e-05_rb, &
+      1.47558e-05_rb,1.49595e-05_rb,1.51647e-05_rb,1.53716e-05_rb,1.55800e-05_rb, &
+      1.57900e-05_rb,1.60017e-05_rb,1.62149e-05_rb,1.64296e-05_rb,1.66460e-05_rb, &
+      1.68640e-05_rb/)
+      totplnk(1:50, 8) = (/ &
+      6.74445e-08_rb,7.18176e-08_rb,7.64153e-08_rb,8.12456e-08_rb,8.63170e-08_rb, &
+      9.16378e-08_rb,9.72168e-08_rb,1.03063e-07_rb,1.09184e-07_rb,1.15591e-07_rb, &
+      1.22292e-07_rb,1.29296e-07_rb,1.36613e-07_rb,1.44253e-07_rb,1.52226e-07_rb, &
+      1.60540e-07_rb,1.69207e-07_rb,1.78236e-07_rb,1.87637e-07_rb,1.97421e-07_rb, &
+      2.07599e-07_rb,2.18181e-07_rb,2.29177e-07_rb,2.40598e-07_rb,2.52456e-07_rb, &
+      2.64761e-07_rb,2.77523e-07_rb,2.90755e-07_rb,3.04468e-07_rb,3.18673e-07_rb, &
+      3.33381e-07_rb,3.48603e-07_rb,3.64352e-07_rb,3.80638e-07_rb,3.97474e-07_rb, &
+      4.14871e-07_rb,4.32841e-07_rb,4.51395e-07_rb,4.70547e-07_rb,4.90306e-07_rb, &
+      5.10687e-07_rb,5.31699e-07_rb,5.53357e-07_rb,5.75670e-07_rb,5.98652e-07_rb, &
+      6.22315e-07_rb,6.46672e-07_rb,6.71731e-07_rb,6.97511e-07_rb,7.24018e-07_rb/)
+      totplnk(51:100, 8) = (/ &
+      7.51266e-07_rb,7.79269e-07_rb,8.08038e-07_rb,8.37584e-07_rb,8.67922e-07_rb, &
+      8.99061e-07_rb,9.31016e-07_rb,9.63797e-07_rb,9.97417e-07_rb,1.03189e-06_rb, &
+      1.06722e-06_rb,1.10343e-06_rb,1.14053e-06_rb,1.17853e-06_rb,1.21743e-06_rb, &
+      1.25726e-06_rb,1.29803e-06_rb,1.33974e-06_rb,1.38241e-06_rb,1.42606e-06_rb, &
+      1.47068e-06_rb,1.51630e-06_rb,1.56293e-06_rb,1.61056e-06_rb,1.65924e-06_rb, &
+      1.70894e-06_rb,1.75971e-06_rb,1.81153e-06_rb,1.86443e-06_rb,1.91841e-06_rb, &
+      1.97350e-06_rb,2.02968e-06_rb,2.08699e-06_rb,2.14543e-06_rb,2.20500e-06_rb, &
+      2.26573e-06_rb,2.32762e-06_rb,2.39068e-06_rb,2.45492e-06_rb,2.52036e-06_rb, &
+      2.58700e-06_rb,2.65485e-06_rb,2.72393e-06_rb,2.79424e-06_rb,2.86580e-06_rb, &
+      2.93861e-06_rb,3.01269e-06_rb,3.08803e-06_rb,3.16467e-06_rb,3.24259e-06_rb/)
+      totplnk(101:150, 8) = (/ &
+      3.32181e-06_rb,3.40235e-06_rb,3.48420e-06_rb,3.56739e-06_rb,3.65192e-06_rb, &
+      3.73779e-06_rb,3.82502e-06_rb,3.91362e-06_rb,4.00359e-06_rb,4.09494e-06_rb, &
+      4.18768e-06_rb,4.28182e-06_rb,4.37737e-06_rb,4.47434e-06_rb,4.57273e-06_rb, &
+      4.67254e-06_rb,4.77380e-06_rb,4.87651e-06_rb,4.98067e-06_rb,5.08630e-06_rb, &
+      5.19339e-06_rb,5.30196e-06_rb,5.41201e-06_rb,5.52356e-06_rb,5.63660e-06_rb, &
+      5.75116e-06_rb,5.86722e-06_rb,5.98479e-06_rb,6.10390e-06_rb,6.22453e-06_rb, &
+      6.34669e-06_rb,6.47042e-06_rb,6.59569e-06_rb,6.72252e-06_rb,6.85090e-06_rb, &
+      6.98085e-06_rb,7.11238e-06_rb,7.24549e-06_rb,7.38019e-06_rb,7.51646e-06_rb, &
+      7.65434e-06_rb,7.79382e-06_rb,7.93490e-06_rb,8.07760e-06_rb,8.22192e-06_rb, &
+      8.36784e-06_rb,8.51540e-06_rb,8.66459e-06_rb,8.81542e-06_rb,8.96786e-06_rb/)
+      totplnk(151:181, 8) = (/ &
+      9.12197e-06_rb,9.27772e-06_rb,9.43513e-06_rb,9.59419e-06_rb,9.75490e-06_rb, &
+      9.91728e-06_rb,1.00813e-05_rb,1.02471e-05_rb,1.04144e-05_rb,1.05835e-05_rb, &
+      1.07543e-05_rb,1.09267e-05_rb,1.11008e-05_rb,1.12766e-05_rb,1.14541e-05_rb, &
+      1.16333e-05_rb,1.18142e-05_rb,1.19969e-05_rb,1.21812e-05_rb,1.23672e-05_rb, &
+      1.25549e-05_rb,1.27443e-05_rb,1.29355e-05_rb,1.31284e-05_rb,1.33229e-05_rb, &
+      1.35193e-05_rb,1.37173e-05_rb,1.39170e-05_rb,1.41185e-05_rb,1.43217e-05_rb, &
+      1.45267e-05_rb/)
+      totplnk(1:50, 9) = (/ &
+      2.61522e-08_rb,2.80613e-08_rb,3.00838e-08_rb,3.22250e-08_rb,3.44899e-08_rb, &
+      3.68841e-08_rb,3.94129e-08_rb,4.20820e-08_rb,4.48973e-08_rb,4.78646e-08_rb, &
+      5.09901e-08_rb,5.42799e-08_rb,5.77405e-08_rb,6.13784e-08_rb,6.52001e-08_rb, &
+      6.92126e-08_rb,7.34227e-08_rb,7.78375e-08_rb,8.24643e-08_rb,8.73103e-08_rb, &
+      9.23832e-08_rb,9.76905e-08_rb,1.03240e-07_rb,1.09039e-07_rb,1.15097e-07_rb, &
+      1.21421e-07_rb,1.28020e-07_rb,1.34902e-07_rb,1.42075e-07_rb,1.49548e-07_rb, &
+      1.57331e-07_rb,1.65432e-07_rb,1.73860e-07_rb,1.82624e-07_rb,1.91734e-07_rb, &
+      2.01198e-07_rb,2.11028e-07_rb,2.21231e-07_rb,2.31818e-07_rb,2.42799e-07_rb, &
+      2.54184e-07_rb,2.65983e-07_rb,2.78205e-07_rb,2.90862e-07_rb,3.03963e-07_rb, &
+      3.17519e-07_rb,3.31541e-07_rb,3.46039e-07_rb,3.61024e-07_rb,3.76507e-07_rb/)
+      totplnk(51:100, 9) = (/ &
+      3.92498e-07_rb,4.09008e-07_rb,4.26050e-07_rb,4.43633e-07_rb,4.61769e-07_rb, &
+      4.80469e-07_rb,4.99744e-07_rb,5.19606e-07_rb,5.40067e-07_rb,5.61136e-07_rb, &
+      5.82828e-07_rb,6.05152e-07_rb,6.28120e-07_rb,6.51745e-07_rb,6.76038e-07_rb, &
+      7.01010e-07_rb,7.26674e-07_rb,7.53041e-07_rb,7.80124e-07_rb,8.07933e-07_rb, &
+      8.36482e-07_rb,8.65781e-07_rb,8.95845e-07_rb,9.26683e-07_rb,9.58308e-07_rb, &
+      9.90732e-07_rb,1.02397e-06_rb,1.05803e-06_rb,1.09292e-06_rb,1.12866e-06_rb, &
+      1.16526e-06_rb,1.20274e-06_rb,1.24109e-06_rb,1.28034e-06_rb,1.32050e-06_rb, &
+      1.36158e-06_rb,1.40359e-06_rb,1.44655e-06_rb,1.49046e-06_rb,1.53534e-06_rb, &
+      1.58120e-06_rb,1.62805e-06_rb,1.67591e-06_rb,1.72478e-06_rb,1.77468e-06_rb, &
+      1.82561e-06_rb,1.87760e-06_rb,1.93066e-06_rb,1.98479e-06_rb,2.04000e-06_rb/)
+      totplnk(101:150, 9) = (/ &
+      2.09631e-06_rb,2.15373e-06_rb,2.21228e-06_rb,2.27196e-06_rb,2.33278e-06_rb, &
+      2.39475e-06_rb,2.45790e-06_rb,2.52222e-06_rb,2.58773e-06_rb,2.65445e-06_rb, &
+      2.72238e-06_rb,2.79152e-06_rb,2.86191e-06_rb,2.93354e-06_rb,3.00643e-06_rb, &
+      3.08058e-06_rb,3.15601e-06_rb,3.23273e-06_rb,3.31075e-06_rb,3.39009e-06_rb, &
+      3.47074e-06_rb,3.55272e-06_rb,3.63605e-06_rb,3.72072e-06_rb,3.80676e-06_rb, &
+      3.89417e-06_rb,3.98297e-06_rb,4.07315e-06_rb,4.16474e-06_rb,4.25774e-06_rb, &
+      4.35217e-06_rb,4.44802e-06_rb,4.54532e-06_rb,4.64406e-06_rb,4.74428e-06_rb, &
+      4.84595e-06_rb,4.94911e-06_rb,5.05376e-06_rb,5.15990e-06_rb,5.26755e-06_rb, &
+      5.37671e-06_rb,5.48741e-06_rb,5.59963e-06_rb,5.71340e-06_rb,5.82871e-06_rb, &
+      5.94559e-06_rb,6.06403e-06_rb,6.18404e-06_rb,6.30565e-06_rb,6.42885e-06_rb/)
+      totplnk(151:181, 9) = (/ &
+      6.55364e-06_rb,6.68004e-06_rb,6.80806e-06_rb,6.93771e-06_rb,7.06898e-06_rb, &
+      7.20190e-06_rb,7.33646e-06_rb,7.47267e-06_rb,7.61056e-06_rb,7.75010e-06_rb, &
+      7.89133e-06_rb,8.03423e-06_rb,8.17884e-06_rb,8.32514e-06_rb,8.47314e-06_rb, &
+      8.62284e-06_rb,8.77427e-06_rb,8.92743e-06_rb,9.08231e-06_rb,9.23893e-06_rb, &
+      9.39729e-06_rb,9.55741e-06_rb,9.71927e-06_rb,9.88291e-06_rb,1.00483e-05_rb, &
+      1.02155e-05_rb,1.03844e-05_rb,1.05552e-05_rb,1.07277e-05_rb,1.09020e-05_rb, &
+      1.10781e-05_rb/)
+      totplnk(1:50,10) = (/ &
+      8.89300e-09_rb,9.63263e-09_rb,1.04235e-08_rb,1.12685e-08_rb,1.21703e-08_rb, &
+      1.31321e-08_rb,1.41570e-08_rb,1.52482e-08_rb,1.64090e-08_rb,1.76428e-08_rb, &
+      1.89533e-08_rb,2.03441e-08_rb,2.18190e-08_rb,2.33820e-08_rb,2.50370e-08_rb, &
+      2.67884e-08_rb,2.86402e-08_rb,3.05969e-08_rb,3.26632e-08_rb,3.48436e-08_rb, &
+      3.71429e-08_rb,3.95660e-08_rb,4.21179e-08_rb,4.48040e-08_rb,4.76294e-08_rb, &
+      5.05996e-08_rb,5.37201e-08_rb,5.69966e-08_rb,6.04349e-08_rb,6.40411e-08_rb, &
+      6.78211e-08_rb,7.17812e-08_rb,7.59276e-08_rb,8.02670e-08_rb,8.48059e-08_rb, &
+      8.95508e-08_rb,9.45090e-08_rb,9.96873e-08_rb,1.05093e-07_rb,1.10733e-07_rb, &
+      1.16614e-07_rb,1.22745e-07_rb,1.29133e-07_rb,1.35786e-07_rb,1.42711e-07_rb, &
+      1.49916e-07_rb,1.57410e-07_rb,1.65202e-07_rb,1.73298e-07_rb,1.81709e-07_rb/)
+      totplnk(51:100,10) = (/ &
+      1.90441e-07_rb,1.99505e-07_rb,2.08908e-07_rb,2.18660e-07_rb,2.28770e-07_rb, &
+      2.39247e-07_rb,2.50101e-07_rb,2.61340e-07_rb,2.72974e-07_rb,2.85013e-07_rb, &
+      2.97467e-07_rb,3.10345e-07_rb,3.23657e-07_rb,3.37413e-07_rb,3.51623e-07_rb, &
+      3.66298e-07_rb,3.81448e-07_rb,3.97082e-07_rb,4.13212e-07_rb,4.29848e-07_rb, &
+      4.47000e-07_rb,4.64680e-07_rb,4.82898e-07_rb,5.01664e-07_rb,5.20991e-07_rb, &
+      5.40888e-07_rb,5.61369e-07_rb,5.82440e-07_rb,6.04118e-07_rb,6.26410e-07_rb, &
+      6.49329e-07_rb,6.72887e-07_rb,6.97095e-07_rb,7.21964e-07_rb,7.47506e-07_rb, &
+      7.73732e-07_rb,8.00655e-07_rb,8.28287e-07_rb,8.56635e-07_rb,8.85717e-07_rb, &
+      9.15542e-07_rb,9.46122e-07_rb,9.77469e-07_rb,1.00960e-06_rb,1.04251e-06_rb, &
+      1.07623e-06_rb,1.11077e-06_rb,1.14613e-06_rb,1.18233e-06_rb,1.21939e-06_rb/)
+      totplnk(101:150,10) = (/ &
+      1.25730e-06_rb,1.29610e-06_rb,1.33578e-06_rb,1.37636e-06_rb,1.41785e-06_rb, &
+      1.46027e-06_rb,1.50362e-06_rb,1.54792e-06_rb,1.59319e-06_rb,1.63942e-06_rb, &
+      1.68665e-06_rb,1.73487e-06_rb,1.78410e-06_rb,1.83435e-06_rb,1.88564e-06_rb, &
+      1.93797e-06_rb,1.99136e-06_rb,2.04582e-06_rb,2.10137e-06_rb,2.15801e-06_rb, &
+      2.21576e-06_rb,2.27463e-06_rb,2.33462e-06_rb,2.39577e-06_rb,2.45806e-06_rb, &
+      2.52153e-06_rb,2.58617e-06_rb,2.65201e-06_rb,2.71905e-06_rb,2.78730e-06_rb, &
+      2.85678e-06_rb,2.92749e-06_rb,2.99946e-06_rb,3.07269e-06_rb,3.14720e-06_rb, &
+      3.22299e-06_rb,3.30007e-06_rb,3.37847e-06_rb,3.45818e-06_rb,3.53923e-06_rb, &
+      3.62161e-06_rb,3.70535e-06_rb,3.79046e-06_rb,3.87695e-06_rb,3.96481e-06_rb, &
+      4.05409e-06_rb,4.14477e-06_rb,4.23687e-06_rb,4.33040e-06_rb,4.42538e-06_rb/)
+      totplnk(151:181,10) = (/ &
+      4.52180e-06_rb,4.61969e-06_rb,4.71905e-06_rb,4.81991e-06_rb,4.92226e-06_rb, &
+      5.02611e-06_rb,5.13148e-06_rb,5.23839e-06_rb,5.34681e-06_rb,5.45681e-06_rb, &
+      5.56835e-06_rb,5.68146e-06_rb,5.79614e-06_rb,5.91242e-06_rb,6.03030e-06_rb, &
+      6.14978e-06_rb,6.27088e-06_rb,6.39360e-06_rb,6.51798e-06_rb,6.64398e-06_rb, &
+      6.77165e-06_rb,6.90099e-06_rb,7.03198e-06_rb,7.16468e-06_rb,7.29906e-06_rb, &
+      7.43514e-06_rb,7.57294e-06_rb,7.71244e-06_rb,7.85369e-06_rb,7.99666e-06_rb, &
+      8.14138e-06_rb/)
+      totplnk(1:50,11) = (/ &
+      2.53767e-09_rb,2.77242e-09_rb,3.02564e-09_rb,3.29851e-09_rb,3.59228e-09_rb, &
+      3.90825e-09_rb,4.24777e-09_rb,4.61227e-09_rb,5.00322e-09_rb,5.42219e-09_rb, &
+      5.87080e-09_rb,6.35072e-09_rb,6.86370e-09_rb,7.41159e-09_rb,7.99628e-09_rb, &
+      8.61974e-09_rb,9.28404e-09_rb,9.99130e-09_rb,1.07437e-08_rb,1.15436e-08_rb, &
+      1.23933e-08_rb,1.32953e-08_rb,1.42522e-08_rb,1.52665e-08_rb,1.63410e-08_rb, &
+      1.74786e-08_rb,1.86820e-08_rb,1.99542e-08_rb,2.12985e-08_rb,2.27179e-08_rb, &
+      2.42158e-08_rb,2.57954e-08_rb,2.74604e-08_rb,2.92141e-08_rb,3.10604e-08_rb, &
+      3.30029e-08_rb,3.50457e-08_rb,3.71925e-08_rb,3.94476e-08_rb,4.18149e-08_rb, &
+      4.42991e-08_rb,4.69043e-08_rb,4.96352e-08_rb,5.24961e-08_rb,5.54921e-08_rb, &
+      5.86277e-08_rb,6.19081e-08_rb,6.53381e-08_rb,6.89231e-08_rb,7.26681e-08_rb/)
+      totplnk(51:100,11) = (/ &
+      7.65788e-08_rb,8.06604e-08_rb,8.49187e-08_rb,8.93591e-08_rb,9.39879e-08_rb, &
+      9.88106e-08_rb,1.03834e-07_rb,1.09063e-07_rb,1.14504e-07_rb,1.20165e-07_rb, &
+      1.26051e-07_rb,1.32169e-07_rb,1.38525e-07_rb,1.45128e-07_rb,1.51982e-07_rb, &
+      1.59096e-07_rb,1.66477e-07_rb,1.74132e-07_rb,1.82068e-07_rb,1.90292e-07_rb, &
+      1.98813e-07_rb,2.07638e-07_rb,2.16775e-07_rb,2.26231e-07_rb,2.36015e-07_rb, &
+      2.46135e-07_rb,2.56599e-07_rb,2.67415e-07_rb,2.78592e-07_rb,2.90137e-07_rb, &
+      3.02061e-07_rb,3.14371e-07_rb,3.27077e-07_rb,3.40186e-07_rb,3.53710e-07_rb, &
+      3.67655e-07_rb,3.82031e-07_rb,3.96848e-07_rb,4.12116e-07_rb,4.27842e-07_rb, &
+      4.44039e-07_rb,4.60713e-07_rb,4.77876e-07_rb,4.95537e-07_rb,5.13706e-07_rb, &
+      5.32392e-07_rb,5.51608e-07_rb,5.71360e-07_rb,5.91662e-07_rb,6.12521e-07_rb/)
+      totplnk(101:150,11) = (/ &
+      6.33950e-07_rb,6.55958e-07_rb,6.78556e-07_rb,7.01753e-07_rb,7.25562e-07_rb, &
+      7.49992e-07_rb,7.75055e-07_rb,8.00760e-07_rb,8.27120e-07_rb,8.54145e-07_rb, &
+      8.81845e-07_rb,9.10233e-07_rb,9.39318e-07_rb,9.69113e-07_rb,9.99627e-07_rb, &
+      1.03087e-06_rb,1.06286e-06_rb,1.09561e-06_rb,1.12912e-06_rb,1.16340e-06_rb, &
+      1.19848e-06_rb,1.23435e-06_rb,1.27104e-06_rb,1.30855e-06_rb,1.34690e-06_rb, &
+      1.38609e-06_rb,1.42614e-06_rb,1.46706e-06_rb,1.50886e-06_rb,1.55155e-06_rb, &
+      1.59515e-06_rb,1.63967e-06_rb,1.68512e-06_rb,1.73150e-06_rb,1.77884e-06_rb, &
+      1.82715e-06_rb,1.87643e-06_rb,1.92670e-06_rb,1.97797e-06_rb,2.03026e-06_rb, &
+      2.08356e-06_rb,2.13791e-06_rb,2.19330e-06_rb,2.24975e-06_rb,2.30728e-06_rb, &
+      2.36589e-06_rb,2.42560e-06_rb,2.48641e-06_rb,2.54835e-06_rb,2.61142e-06_rb/)
+      totplnk(151:181,11) = (/ &
+      2.67563e-06_rb,2.74100e-06_rb,2.80754e-06_rb,2.87526e-06_rb,2.94417e-06_rb, &
+      3.01429e-06_rb,3.08562e-06_rb,3.15819e-06_rb,3.23199e-06_rb,3.30704e-06_rb, &
+      3.38336e-06_rb,3.46096e-06_rb,3.53984e-06_rb,3.62002e-06_rb,3.70151e-06_rb, &
+      3.78433e-06_rb,3.86848e-06_rb,3.95399e-06_rb,4.04084e-06_rb,4.12907e-06_rb, &
+      4.21868e-06_rb,4.30968e-06_rb,4.40209e-06_rb,4.49592e-06_rb,4.59117e-06_rb, &
+      4.68786e-06_rb,4.78600e-06_rb,4.88561e-06_rb,4.98669e-06_rb,5.08926e-06_rb, &
+      5.19332e-06_rb/)
+      totplnk(1:50,12) = (/ &
+      2.73921e-10_rb,3.04500e-10_rb,3.38056e-10_rb,3.74835e-10_rb,4.15099e-10_rb, &
+      4.59126e-10_rb,5.07214e-10_rb,5.59679e-10_rb,6.16857e-10_rb,6.79103e-10_rb, &
+      7.46796e-10_rb,8.20335e-10_rb,9.00144e-10_rb,9.86671e-10_rb,1.08039e-09_rb, &
+      1.18180e-09_rb,1.29142e-09_rb,1.40982e-09_rb,1.53757e-09_rb,1.67529e-09_rb, &
+      1.82363e-09_rb,1.98327e-09_rb,2.15492e-09_rb,2.33932e-09_rb,2.53726e-09_rb, &
+      2.74957e-09_rb,2.97710e-09_rb,3.22075e-09_rb,3.48145e-09_rb,3.76020e-09_rb, &
+      4.05801e-09_rb,4.37595e-09_rb,4.71513e-09_rb,5.07672e-09_rb,5.46193e-09_rb, &
+      5.87201e-09_rb,6.30827e-09_rb,6.77205e-09_rb,7.26480e-09_rb,7.78794e-09_rb, &
+      8.34304e-09_rb,8.93163e-09_rb,9.55537e-09_rb,1.02159e-08_rb,1.09151e-08_rb, &
+      1.16547e-08_rb,1.24365e-08_rb,1.32625e-08_rb,1.41348e-08_rb,1.50554e-08_rb/)
+      totplnk(51:100,12) = (/ &
+      1.60264e-08_rb,1.70500e-08_rb,1.81285e-08_rb,1.92642e-08_rb,2.04596e-08_rb, &
+      2.17171e-08_rb,2.30394e-08_rb,2.44289e-08_rb,2.58885e-08_rb,2.74209e-08_rb, &
+      2.90290e-08_rb,3.07157e-08_rb,3.24841e-08_rb,3.43371e-08_rb,3.62782e-08_rb, &
+      3.83103e-08_rb,4.04371e-08_rb,4.26617e-08_rb,4.49878e-08_rb,4.74190e-08_rb, &
+      4.99589e-08_rb,5.26113e-08_rb,5.53801e-08_rb,5.82692e-08_rb,6.12826e-08_rb, &
+      6.44245e-08_rb,6.76991e-08_rb,7.11105e-08_rb,7.46634e-08_rb,7.83621e-08_rb, &
+      8.22112e-08_rb,8.62154e-08_rb,9.03795e-08_rb,9.47081e-08_rb,9.92066e-08_rb, &
+      1.03879e-07_rb,1.08732e-07_rb,1.13770e-07_rb,1.18998e-07_rb,1.24422e-07_rb, &
+      1.30048e-07_rb,1.35880e-07_rb,1.41924e-07_rb,1.48187e-07_rb,1.54675e-07_rb, &
+      1.61392e-07_rb,1.68346e-07_rb,1.75543e-07_rb,1.82988e-07_rb,1.90688e-07_rb/)
+      totplnk(101:150,12) = (/ &
+      1.98650e-07_rb,2.06880e-07_rb,2.15385e-07_rb,2.24172e-07_rb,2.33247e-07_rb, &
+      2.42617e-07_rb,2.52289e-07_rb,2.62272e-07_rb,2.72571e-07_rb,2.83193e-07_rb, &
+      2.94147e-07_rb,3.05440e-07_rb,3.17080e-07_rb,3.29074e-07_rb,3.41430e-07_rb, &
+      3.54155e-07_rb,3.67259e-07_rb,3.80747e-07_rb,3.94631e-07_rb,4.08916e-07_rb, &
+      4.23611e-07_rb,4.38725e-07_rb,4.54267e-07_rb,4.70245e-07_rb,4.86666e-07_rb, &
+      5.03541e-07_rb,5.20879e-07_rb,5.38687e-07_rb,5.56975e-07_rb,5.75751e-07_rb, &
+      5.95026e-07_rb,6.14808e-07_rb,6.35107e-07_rb,6.55932e-07_rb,6.77293e-07_rb, &
+      6.99197e-07_rb,7.21656e-07_rb,7.44681e-07_rb,7.68278e-07_rb,7.92460e-07_rb, &
+      8.17235e-07_rb,8.42614e-07_rb,8.68606e-07_rb,8.95223e-07_rb,9.22473e-07_rb, &
+      9.50366e-07_rb,9.78915e-07_rb,1.00813e-06_rb,1.03802e-06_rb,1.06859e-06_rb/)
+      totplnk(151:181,12) = (/ &
+      1.09986e-06_rb,1.13184e-06_rb,1.16453e-06_rb,1.19796e-06_rb,1.23212e-06_rb, &
+      1.26703e-06_rb,1.30270e-06_rb,1.33915e-06_rb,1.37637e-06_rb,1.41440e-06_rb, &
+      1.45322e-06_rb,1.49286e-06_rb,1.53333e-06_rb,1.57464e-06_rb,1.61679e-06_rb, &
+      1.65981e-06_rb,1.70370e-06_rb,1.74847e-06_rb,1.79414e-06_rb,1.84071e-06_rb, &
+      1.88821e-06_rb,1.93663e-06_rb,1.98599e-06_rb,2.03631e-06_rb,2.08759e-06_rb, &
+      2.13985e-06_rb,2.19310e-06_rb,2.24734e-06_rb,2.30260e-06_rb,2.35888e-06_rb, &
+      2.41619e-06_rb/)
+      totplnk(1:50,13) = (/ &
+      4.53634e-11_rb,5.11435e-11_rb,5.75754e-11_rb,6.47222e-11_rb,7.26531e-11_rb, &
+      8.14420e-11_rb,9.11690e-11_rb,1.01921e-10_rb,1.13790e-10_rb,1.26877e-10_rb, &
+      1.41288e-10_rb,1.57140e-10_rb,1.74555e-10_rb,1.93665e-10_rb,2.14613e-10_rb, &
+      2.37548e-10_rb,2.62633e-10_rb,2.90039e-10_rb,3.19948e-10_rb,3.52558e-10_rb, &
+      3.88073e-10_rb,4.26716e-10_rb,4.68719e-10_rb,5.14331e-10_rb,5.63815e-10_rb, &
+      6.17448e-10_rb,6.75526e-10_rb,7.38358e-10_rb,8.06277e-10_rb,8.79625e-10_rb, &
+      9.58770e-10_rb,1.04410e-09_rb,1.13602e-09_rb,1.23495e-09_rb,1.34135e-09_rb, &
+      1.45568e-09_rb,1.57845e-09_rb,1.71017e-09_rb,1.85139e-09_rb,2.00268e-09_rb, &
+      2.16464e-09_rb,2.33789e-09_rb,2.52309e-09_rb,2.72093e-09_rb,2.93212e-09_rb, &
+      3.15740e-09_rb,3.39757e-09_rb,3.65341e-09_rb,3.92579e-09_rb,4.21559e-09_rb/)
+      totplnk(51:100,13) = (/ &
+      4.52372e-09_rb,4.85115e-09_rb,5.19886e-09_rb,5.56788e-09_rb,5.95928e-09_rb, &
+      6.37419e-09_rb,6.81375e-09_rb,7.27917e-09_rb,7.77168e-09_rb,8.29256e-09_rb, &
+      8.84317e-09_rb,9.42487e-09_rb,1.00391e-08_rb,1.06873e-08_rb,1.13710e-08_rb, &
+      1.20919e-08_rb,1.28515e-08_rb,1.36514e-08_rb,1.44935e-08_rb,1.53796e-08_rb, &
+      1.63114e-08_rb,1.72909e-08_rb,1.83201e-08_rb,1.94008e-08_rb,2.05354e-08_rb, &
+      2.17258e-08_rb,2.29742e-08_rb,2.42830e-08_rb,2.56545e-08_rb,2.70910e-08_rb, &
+      2.85950e-08_rb,3.01689e-08_rb,3.18155e-08_rb,3.35373e-08_rb,3.53372e-08_rb, &
+      3.72177e-08_rb,3.91818e-08_rb,4.12325e-08_rb,4.33727e-08_rb,4.56056e-08_rb, &
+      4.79342e-08_rb,5.03617e-08_rb,5.28915e-08_rb,5.55270e-08_rb,5.82715e-08_rb, &
+      6.11286e-08_rb,6.41019e-08_rb,6.71951e-08_rb,7.04119e-08_rb,7.37560e-08_rb/)
+      totplnk(101:150,13) = (/ &
+      7.72315e-08_rb,8.08424e-08_rb,8.45927e-08_rb,8.84866e-08_rb,9.25281e-08_rb, &
+      9.67218e-08_rb,1.01072e-07_rb,1.05583e-07_rb,1.10260e-07_rb,1.15107e-07_rb, &
+      1.20128e-07_rb,1.25330e-07_rb,1.30716e-07_rb,1.36291e-07_rb,1.42061e-07_rb, &
+      1.48031e-07_rb,1.54206e-07_rb,1.60592e-07_rb,1.67192e-07_rb,1.74015e-07_rb, &
+      1.81064e-07_rb,1.88345e-07_rb,1.95865e-07_rb,2.03628e-07_rb,2.11643e-07_rb, &
+      2.19912e-07_rb,2.28443e-07_rb,2.37244e-07_rb,2.46318e-07_rb,2.55673e-07_rb, &
+      2.65316e-07_rb,2.75252e-07_rb,2.85489e-07_rb,2.96033e-07_rb,3.06891e-07_rb, &
+      3.18070e-07_rb,3.29576e-07_rb,3.41417e-07_rb,3.53600e-07_rb,3.66133e-07_rb, &
+      3.79021e-07_rb,3.92274e-07_rb,4.05897e-07_rb,4.19899e-07_rb,4.34288e-07_rb, &
+      4.49071e-07_rb,4.64255e-07_rb,4.79850e-07_rb,4.95863e-07_rb,5.12300e-07_rb/)
+      totplnk(151:181,13) = (/ &
+      5.29172e-07_rb,5.46486e-07_rb,5.64250e-07_rb,5.82473e-07_rb,6.01164e-07_rb, &
+      6.20329e-07_rb,6.39979e-07_rb,6.60122e-07_rb,6.80767e-07_rb,7.01922e-07_rb, &
+      7.23596e-07_rb,7.45800e-07_rb,7.68539e-07_rb,7.91826e-07_rb,8.15669e-07_rb, &
+      8.40076e-07_rb,8.65058e-07_rb,8.90623e-07_rb,9.16783e-07_rb,9.43544e-07_rb, &
+      9.70917e-07_rb,9.98912e-07_rb,1.02754e-06_rb,1.05681e-06_rb,1.08673e-06_rb, &
+      1.11731e-06_rb,1.14856e-06_rb,1.18050e-06_rb,1.21312e-06_rb,1.24645e-06_rb, &
+      1.28049e-06_rb/)
+      totplnk(1:50,14) = (/ &
+      1.40113e-11_rb,1.59358e-11_rb,1.80960e-11_rb,2.05171e-11_rb,2.32266e-11_rb, &
+      2.62546e-11_rb,2.96335e-11_rb,3.33990e-11_rb,3.75896e-11_rb,4.22469e-11_rb, &
+      4.74164e-11_rb,5.31466e-11_rb,5.94905e-11_rb,6.65054e-11_rb,7.42522e-11_rb, &
+      8.27975e-11_rb,9.22122e-11_rb,1.02573e-10_rb,1.13961e-10_rb,1.26466e-10_rb, &
+      1.40181e-10_rb,1.55206e-10_rb,1.71651e-10_rb,1.89630e-10_rb,2.09265e-10_rb, &
+      2.30689e-10_rb,2.54040e-10_rb,2.79467e-10_rb,3.07128e-10_rb,3.37190e-10_rb, &
+      3.69833e-10_rb,4.05243e-10_rb,4.43623e-10_rb,4.85183e-10_rb,5.30149e-10_rb, &
+      5.78755e-10_rb,6.31255e-10_rb,6.87910e-10_rb,7.49002e-10_rb,8.14824e-10_rb, &
+      8.85687e-10_rb,9.61914e-10_rb,1.04385e-09_rb,1.13186e-09_rb,1.22631e-09_rb, &
+      1.32761e-09_rb,1.43617e-09_rb,1.55243e-09_rb,1.67686e-09_rb,1.80992e-09_rb/)
+      totplnk(51:100,14) = (/ &
+      1.95212e-09_rb,2.10399e-09_rb,2.26607e-09_rb,2.43895e-09_rb,2.62321e-09_rb, &
+      2.81949e-09_rb,3.02844e-09_rb,3.25073e-09_rb,3.48707e-09_rb,3.73820e-09_rb, &
+      4.00490e-09_rb,4.28794e-09_rb,4.58819e-09_rb,4.90647e-09_rb,5.24371e-09_rb, &
+      5.60081e-09_rb,5.97875e-09_rb,6.37854e-09_rb,6.80120e-09_rb,7.24782e-09_rb, &
+      7.71950e-09_rb,8.21740e-09_rb,8.74271e-09_rb,9.29666e-09_rb,9.88054e-09_rb, &
+      1.04956e-08_rb,1.11434e-08_rb,1.18251e-08_rb,1.25422e-08_rb,1.32964e-08_rb, &
+      1.40890e-08_rb,1.49217e-08_rb,1.57961e-08_rb,1.67140e-08_rb,1.76771e-08_rb, &
+      1.86870e-08_rb,1.97458e-08_rb,2.08553e-08_rb,2.20175e-08_rb,2.32342e-08_rb, &
+      2.45077e-08_rb,2.58401e-08_rb,2.72334e-08_rb,2.86900e-08_rb,3.02122e-08_rb, &
+      3.18021e-08_rb,3.34624e-08_rb,3.51954e-08_rb,3.70037e-08_rb,3.88899e-08_rb/)
+      totplnk(101:150,14) = (/ &
+      4.08568e-08_rb,4.29068e-08_rb,4.50429e-08_rb,4.72678e-08_rb,4.95847e-08_rb, &
+      5.19963e-08_rb,5.45058e-08_rb,5.71161e-08_rb,5.98309e-08_rb,6.26529e-08_rb, &
+      6.55857e-08_rb,6.86327e-08_rb,7.17971e-08_rb,7.50829e-08_rb,7.84933e-08_rb, &
+      8.20323e-08_rb,8.57035e-08_rb,8.95105e-08_rb,9.34579e-08_rb,9.75488e-08_rb, &
+      1.01788e-07_rb,1.06179e-07_rb,1.10727e-07_rb,1.15434e-07_rb,1.20307e-07_rb, &
+      1.25350e-07_rb,1.30566e-07_rb,1.35961e-07_rb,1.41539e-07_rb,1.47304e-07_rb, &
+      1.53263e-07_rb,1.59419e-07_rb,1.65778e-07_rb,1.72345e-07_rb,1.79124e-07_rb, &
+      1.86122e-07_rb,1.93343e-07_rb,2.00792e-07_rb,2.08476e-07_rb,2.16400e-07_rb, &
+      2.24568e-07_rb,2.32988e-07_rb,2.41666e-07_rb,2.50605e-07_rb,2.59813e-07_rb, &
+      2.69297e-07_rb,2.79060e-07_rb,2.89111e-07_rb,2.99455e-07_rb,3.10099e-07_rb/)
+      totplnk(151:181,14) = (/ &
+      3.21049e-07_rb,3.32311e-07_rb,3.43893e-07_rb,3.55801e-07_rb,3.68041e-07_rb, &
+      3.80621e-07_rb,3.93547e-07_rb,4.06826e-07_rb,4.20465e-07_rb,4.34473e-07_rb, &
+      4.48856e-07_rb,4.63620e-07_rb,4.78774e-07_rb,4.94325e-07_rb,5.10280e-07_rb, &
+      5.26648e-07_rb,5.43436e-07_rb,5.60652e-07_rb,5.78302e-07_rb,5.96397e-07_rb, &
+      6.14943e-07_rb,6.33949e-07_rb,6.53421e-07_rb,6.73370e-07_rb,6.93803e-07_rb, &
+      7.14731e-07_rb,7.36157e-07_rb,7.58095e-07_rb,7.80549e-07_rb,8.03533e-07_rb, &
+      8.27050e-07_rb/)
+      totplnk(1:50,15) = (/ &
+      3.90483e-12_rb,4.47999e-12_rb,5.13122e-12_rb,5.86739e-12_rb,6.69829e-12_rb, &
+      7.63467e-12_rb,8.68833e-12_rb,9.87221e-12_rb,1.12005e-11_rb,1.26885e-11_rb, &
+      1.43534e-11_rb,1.62134e-11_rb,1.82888e-11_rb,2.06012e-11_rb,2.31745e-11_rb, &
+      2.60343e-11_rb,2.92087e-11_rb,3.27277e-11_rb,3.66242e-11_rb,4.09334e-11_rb, &
+      4.56935e-11_rb,5.09455e-11_rb,5.67338e-11_rb,6.31057e-11_rb,7.01127e-11_rb, &
+      7.78096e-11_rb,8.62554e-11_rb,9.55130e-11_rb,1.05651e-10_rb,1.16740e-10_rb, &
+      1.28858e-10_rb,1.42089e-10_rb,1.56519e-10_rb,1.72243e-10_rb,1.89361e-10_rb, &
+      2.07978e-10_rb,2.28209e-10_rb,2.50173e-10_rb,2.73999e-10_rb,2.99820e-10_rb, &
+      3.27782e-10_rb,3.58034e-10_rb,3.90739e-10_rb,4.26067e-10_rb,4.64196e-10_rb, &
+      5.05317e-10_rb,5.49631e-10_rb,5.97347e-10_rb,6.48689e-10_rb,7.03891e-10_rb/)
+      totplnk(51:100,15) = (/ &
+      7.63201e-10_rb,8.26876e-10_rb,8.95192e-10_rb,9.68430e-10_rb,1.04690e-09_rb, &
+      1.13091e-09_rb,1.22079e-09_rb,1.31689e-09_rb,1.41957e-09_rb,1.52922e-09_rb, &
+      1.64623e-09_rb,1.77101e-09_rb,1.90401e-09_rb,2.04567e-09_rb,2.19647e-09_rb, &
+      2.35690e-09_rb,2.52749e-09_rb,2.70875e-09_rb,2.90127e-09_rb,3.10560e-09_rb, &
+      3.32238e-09_rb,3.55222e-09_rb,3.79578e-09_rb,4.05375e-09_rb,4.32682e-09_rb, &
+      4.61574e-09_rb,4.92128e-09_rb,5.24420e-09_rb,5.58536e-09_rb,5.94558e-09_rb, &
+      6.32575e-09_rb,6.72678e-09_rb,7.14964e-09_rb,7.59526e-09_rb,8.06470e-09_rb, &
+      8.55897e-09_rb,9.07916e-09_rb,9.62638e-09_rb,1.02018e-08_rb,1.08066e-08_rb, &
+      1.14420e-08_rb,1.21092e-08_rb,1.28097e-08_rb,1.35446e-08_rb,1.43155e-08_rb, &
+      1.51237e-08_rb,1.59708e-08_rb,1.68581e-08_rb,1.77873e-08_rb,1.87599e-08_rb/)
+      totplnk(101:150,15) = (/ &
+      1.97777e-08_rb,2.08423e-08_rb,2.19555e-08_rb,2.31190e-08_rb,2.43348e-08_rb, &
+      2.56045e-08_rb,2.69302e-08_rb,2.83140e-08_rb,2.97578e-08_rb,3.12636e-08_rb, &
+      3.28337e-08_rb,3.44702e-08_rb,3.61755e-08_rb,3.79516e-08_rb,3.98012e-08_rb, &
+      4.17265e-08_rb,4.37300e-08_rb,4.58143e-08_rb,4.79819e-08_rb,5.02355e-08_rb, &
+      5.25777e-08_rb,5.50114e-08_rb,5.75393e-08_rb,6.01644e-08_rb,6.28896e-08_rb, &
+      6.57177e-08_rb,6.86521e-08_rb,7.16959e-08_rb,7.48520e-08_rb,7.81239e-08_rb, &
+      8.15148e-08_rb,8.50282e-08_rb,8.86675e-08_rb,9.24362e-08_rb,9.63380e-08_rb, &
+      1.00376e-07_rb,1.04555e-07_rb,1.08878e-07_rb,1.13349e-07_rb,1.17972e-07_rb, &
+      1.22751e-07_rb,1.27690e-07_rb,1.32793e-07_rb,1.38064e-07_rb,1.43508e-07_rb, &
+      1.49129e-07_rb,1.54931e-07_rb,1.60920e-07_rb,1.67099e-07_rb,1.73473e-07_rb/)
+      totplnk(151:181,15) = (/ &
+      1.80046e-07_rb,1.86825e-07_rb,1.93812e-07_rb,2.01014e-07_rb,2.08436e-07_rb, &
+      2.16082e-07_rb,2.23957e-07_rb,2.32067e-07_rb,2.40418e-07_rb,2.49013e-07_rb, &
+      2.57860e-07_rb,2.66963e-07_rb,2.76328e-07_rb,2.85961e-07_rb,2.95868e-07_rb, &
+      3.06053e-07_rb,3.16524e-07_rb,3.27286e-07_rb,3.38345e-07_rb,3.49707e-07_rb, &
+      3.61379e-07_rb,3.73367e-07_rb,3.85676e-07_rb,3.98315e-07_rb,4.11287e-07_rb, &
+      4.24602e-07_rb,4.38265e-07_rb,4.52283e-07_rb,4.66662e-07_rb,4.81410e-07_rb, &
+      4.96535e-07_rb/)
+      totplnk(1:50,16) = (/ &
+      0.28639e-12_rb,0.33349e-12_rb,0.38764e-12_rb,0.44977e-12_rb,0.52093e-12_rb, &
+      0.60231e-12_rb,0.69522e-12_rb,0.80111e-12_rb,0.92163e-12_rb,0.10586e-11_rb, &
+      0.12139e-11_rb,0.13899e-11_rb,0.15890e-11_rb,0.18138e-11_rb,0.20674e-11_rb, &
+      0.23531e-11_rb,0.26744e-11_rb,0.30352e-11_rb,0.34401e-11_rb,0.38936e-11_rb, &
+      0.44011e-11_rb,0.49681e-11_rb,0.56010e-11_rb,0.63065e-11_rb,0.70919e-11_rb, &
+      0.79654e-11_rb,0.89357e-11_rb,0.10012e-10_rb,0.11205e-10_rb,0.12526e-10_rb, &
+      0.13986e-10_rb,0.15600e-10_rb,0.17380e-10_rb,0.19342e-10_rb,0.21503e-10_rb, &
+      0.23881e-10_rb,0.26494e-10_rb,0.29362e-10_rb,0.32509e-10_rb,0.35958e-10_rb, &
+      0.39733e-10_rb,0.43863e-10_rb,0.48376e-10_rb,0.53303e-10_rb,0.58679e-10_rb, &
+      0.64539e-10_rb,0.70920e-10_rb,0.77864e-10_rb,0.85413e-10_rb,0.93615e-10_rb/)
+      totplnk(51:100,16) = (/ &
+      0.10252e-09_rb,0.11217e-09_rb,0.12264e-09_rb,0.13397e-09_rb,0.14624e-09_rb, &
+      0.15950e-09_rb,0.17383e-09_rb,0.18930e-09_rb,0.20599e-09_rb,0.22399e-09_rb, &
+      0.24339e-09_rb,0.26427e-09_rb,0.28674e-09_rb,0.31090e-09_rb,0.33686e-09_rb, &
+      0.36474e-09_rb,0.39466e-09_rb,0.42676e-09_rb,0.46115e-09_rb,0.49800e-09_rb, &
+      0.53744e-09_rb,0.57964e-09_rb,0.62476e-09_rb,0.67298e-09_rb,0.72448e-09_rb, &
+      0.77945e-09_rb,0.83809e-09_rb,0.90062e-09_rb,0.96725e-09_rb,0.10382e-08_rb, &
+      0.11138e-08_rb,0.11941e-08_rb,0.12796e-08_rb,0.13704e-08_rb,0.14669e-08_rb, &
+      0.15694e-08_rb,0.16781e-08_rb,0.17934e-08_rb,0.19157e-08_rb,0.20453e-08_rb, &
+      0.21825e-08_rb,0.23278e-08_rb,0.24815e-08_rb,0.26442e-08_rb,0.28161e-08_rb, &
+      0.29978e-08_rb,0.31898e-08_rb,0.33925e-08_rb,0.36064e-08_rb,0.38321e-08_rb/)
+      totplnk(101:150,16) = (/ &
+      0.40700e-08_rb,0.43209e-08_rb,0.45852e-08_rb,0.48636e-08_rb,0.51567e-08_rb, &
+      0.54652e-08_rb,0.57897e-08_rb,0.61310e-08_rb,0.64897e-08_rb,0.68667e-08_rb, &
+      0.72626e-08_rb,0.76784e-08_rb,0.81148e-08_rb,0.85727e-08_rb,0.90530e-08_rb, &
+      0.95566e-08_rb,0.10084e-07_rb,0.10638e-07_rb,0.11217e-07_rb,0.11824e-07_rb, &
+      0.12458e-07_rb,0.13123e-07_rb,0.13818e-07_rb,0.14545e-07_rb,0.15305e-07_rb, &
+      0.16099e-07_rb,0.16928e-07_rb,0.17795e-07_rb,0.18699e-07_rb,0.19643e-07_rb, &
+      0.20629e-07_rb,0.21656e-07_rb,0.22728e-07_rb,0.23845e-07_rb,0.25010e-07_rb, &
+      0.26223e-07_rb,0.27487e-07_rb,0.28804e-07_rb,0.30174e-07_rb,0.31600e-07_rb, &
+      0.33084e-07_rb,0.34628e-07_rb,0.36233e-07_rb,0.37902e-07_rb,0.39637e-07_rb, &
+      0.41440e-07_rb,0.43313e-07_rb,0.45259e-07_rb,0.47279e-07_rb,0.49376e-07_rb/)
+      totplnk(151:181,16) = (/ &
+      0.51552e-07_rb,0.53810e-07_rb,0.56153e-07_rb,0.58583e-07_rb,0.61102e-07_rb, &
+      0.63713e-07_rb,0.66420e-07_rb,0.69224e-07_rb,0.72129e-07_rb,0.75138e-07_rb, &
+      0.78254e-07_rb,0.81479e-07_rb,0.84818e-07_rb,0.88272e-07_rb,0.91846e-07_rb, &
+      0.95543e-07_rb,0.99366e-07_rb,0.10332e-06_rb,0.10740e-06_rb,0.11163e-06_rb, &
+      0.11599e-06_rb,0.12050e-06_rb,0.12515e-06_rb,0.12996e-06_rb,0.13493e-06_rb, &
+      0.14005e-06_rb,0.14534e-06_rb,0.15080e-06_rb,0.15643e-06_rb,0.16224e-06_rb, &
+      0.16823e-06_rb/)
+      totplk16(1:50) = (/ &
+      0.28481e-12_rb,0.33159e-12_rb,0.38535e-12_rb,0.44701e-12_rb,0.51763e-12_rb, &
+      0.59836e-12_rb,0.69049e-12_rb,0.79549e-12_rb,0.91493e-12_rb,0.10506e-11_rb, &
+      0.12045e-11_rb,0.13788e-11_rb,0.15758e-11_rb,0.17984e-11_rb,0.20493e-11_rb, &
+      0.23317e-11_rb,0.26494e-11_rb,0.30060e-11_rb,0.34060e-11_rb,0.38539e-11_rb, &
+      0.43548e-11_rb,0.49144e-11_rb,0.55387e-11_rb,0.62344e-11_rb,0.70086e-11_rb, &
+      0.78692e-11_rb,0.88248e-11_rb,0.98846e-11_rb,0.11059e-10_rb,0.12358e-10_rb, &
+      0.13794e-10_rb,0.15379e-10_rb,0.17128e-10_rb,0.19055e-10_rb,0.21176e-10_rb, &
+      0.23508e-10_rb,0.26070e-10_rb,0.28881e-10_rb,0.31963e-10_rb,0.35339e-10_rb, &
+      0.39034e-10_rb,0.43073e-10_rb,0.47484e-10_rb,0.52299e-10_rb,0.57548e-10_rb, &
+      0.63267e-10_rb,0.69491e-10_rb,0.76261e-10_rb,0.83616e-10_rb,0.91603e-10_rb/)
+      totplk16(51:100) = (/ &
+      0.10027e-09_rb,0.10966e-09_rb,0.11983e-09_rb,0.13084e-09_rb,0.14275e-09_rb, &
+      0.15562e-09_rb,0.16951e-09_rb,0.18451e-09_rb,0.20068e-09_rb,0.21810e-09_rb, &
+      0.23686e-09_rb,0.25704e-09_rb,0.27875e-09_rb,0.30207e-09_rb,0.32712e-09_rb, &
+      0.35400e-09_rb,0.38282e-09_rb,0.41372e-09_rb,0.44681e-09_rb,0.48223e-09_rb, &
+      0.52013e-09_rb,0.56064e-09_rb,0.60392e-09_rb,0.65015e-09_rb,0.69948e-09_rb, &
+      0.75209e-09_rb,0.80818e-09_rb,0.86794e-09_rb,0.93157e-09_rb,0.99929e-09_rb, &
+      0.10713e-08_rb,0.11479e-08_rb,0.12293e-08_rb,0.13157e-08_rb,0.14074e-08_rb, &
+      0.15047e-08_rb,0.16079e-08_rb,0.17172e-08_rb,0.18330e-08_rb,0.19557e-08_rb, &
+      0.20855e-08_rb,0.22228e-08_rb,0.23680e-08_rb,0.25214e-08_rb,0.26835e-08_rb, &
+      0.28546e-08_rb,0.30352e-08_rb,0.32257e-08_rb,0.34266e-08_rb,0.36384e-08_rb/)
+      totplk16(101:150) = (/ &
+      0.38615e-08_rb,0.40965e-08_rb,0.43438e-08_rb,0.46041e-08_rb,0.48779e-08_rb, &
+      0.51658e-08_rb,0.54683e-08_rb,0.57862e-08_rb,0.61200e-08_rb,0.64705e-08_rb, &
+      0.68382e-08_rb,0.72240e-08_rb,0.76285e-08_rb,0.80526e-08_rb,0.84969e-08_rb, &
+      0.89624e-08_rb,0.94498e-08_rb,0.99599e-08_rb,0.10494e-07_rb,0.11052e-07_rb, &
+      0.11636e-07_rb,0.12246e-07_rb,0.12884e-07_rb,0.13551e-07_rb,0.14246e-07_rb, &
+      0.14973e-07_rb,0.15731e-07_rb,0.16522e-07_rb,0.17347e-07_rb,0.18207e-07_rb, &
+      0.19103e-07_rb,0.20037e-07_rb,0.21011e-07_rb,0.22024e-07_rb,0.23079e-07_rb, &
+      0.24177e-07_rb,0.25320e-07_rb,0.26508e-07_rb,0.27744e-07_rb,0.29029e-07_rb, &
+      0.30365e-07_rb,0.31753e-07_rb,0.33194e-07_rb,0.34691e-07_rb,0.36246e-07_rb, &
+      0.37859e-07_rb,0.39533e-07_rb,0.41270e-07_rb,0.43071e-07_rb,0.44939e-07_rb/)
+      totplk16(151:181) = (/ &
+      0.46875e-07_rb,0.48882e-07_rb,0.50961e-07_rb,0.53115e-07_rb,0.55345e-07_rb, &
+      0.57655e-07_rb,0.60046e-07_rb,0.62520e-07_rb,0.65080e-07_rb,0.67728e-07_rb, &
+      0.70466e-07_rb,0.73298e-07_rb,0.76225e-07_rb,0.79251e-07_rb,0.82377e-07_rb, &
+      0.85606e-07_rb,0.88942e-07_rb,0.92386e-07_rb,0.95942e-07_rb,0.99612e-07_rb, &
+      0.10340e-06_rb,0.10731e-06_rb,0.11134e-06_rb,0.11550e-06_rb,0.11979e-06_rb, &
+      0.12421e-06_rb,0.12876e-06_rb,0.13346e-06_rb,0.13830e-06_rb,0.14328e-06_rb, &
+      0.14841e-06_rb/)
+
+      end subroutine lwavplank
+
+!***************************************************************************
+      subroutine lwavplankderiv
+!***************************************************************************
+
+      save
+ 
+      totplnkderiv(1:50,  1) = (/ &
+      2.22125e-08_rb,2.23245e-08_rb,2.24355e-08_rb,2.25435e-08_rb,2.26560e-08_rb, &
+      2.27620e-08_rb,2.28690e-08_rb,2.29760e-08_rb,2.30775e-08_rb,2.31800e-08_rb, &
+      2.32825e-08_rb,2.33825e-08_rb,2.34820e-08_rb,2.35795e-08_rb,2.36760e-08_rb, &
+      2.37710e-08_rb,2.38655e-08_rb,2.39595e-08_rb,2.40530e-08_rb,2.41485e-08_rb, &
+      2.42395e-08_rb,2.43300e-08_rb,2.44155e-08_rb,2.45085e-08_rb,2.45905e-08_rb, &
+      2.46735e-08_rb,2.47565e-08_rb,2.48465e-08_rb,2.49315e-08_rb,2.50100e-08_rb, &
+      2.50905e-08_rb,2.51705e-08_rb,2.52490e-08_rb,2.53260e-08_rb,2.54075e-08_rb, &
+      2.54785e-08_rb,2.55555e-08_rb,2.56340e-08_rb,2.57050e-08_rb,2.57820e-08_rb, &
+      2.58525e-08_rb,2.59205e-08_rb,2.59945e-08_rb,2.60680e-08_rb,2.61375e-08_rb, &
+      2.61980e-08_rb,2.62745e-08_rb,2.63335e-08_rb,2.63995e-08_rb,2.64710e-08_rb/)
+      totplnkderiv(51:100,  1) = (/ &
+      2.65300e-08_rb,2.66005e-08_rb,2.66685e-08_rb,2.67310e-08_rb,2.67915e-08_rb, &
+      2.68540e-08_rb,2.69065e-08_rb,2.69730e-08_rb,2.70270e-08_rb,2.70690e-08_rb, &
+      2.71420e-08_rb,2.71985e-08_rb,2.72560e-08_rb,2.73180e-08_rb,2.73760e-08_rb, &
+      2.74285e-08_rb,2.74840e-08_rb,2.75290e-08_rb,2.75950e-08_rb,2.76360e-08_rb, &
+      2.76975e-08_rb,2.77475e-08_rb,2.78080e-08_rb,2.78375e-08_rb,2.79120e-08_rb, &
+      2.79510e-08_rb,2.79955e-08_rb,2.80625e-08_rb,2.80920e-08_rb,2.81570e-08_rb, &
+      2.81990e-08_rb,2.82330e-08_rb,2.82830e-08_rb,2.83365e-08_rb,2.83740e-08_rb, &
+      2.84295e-08_rb,2.84910e-08_rb,2.85275e-08_rb,2.85525e-08_rb,2.86085e-08_rb, &
+      2.86535e-08_rb,2.86945e-08_rb,2.87355e-08_rb,2.87695e-08_rb,2.88105e-08_rb, &
+      2.88585e-08_rb,2.88945e-08_rb,2.89425e-08_rb,2.89580e-08_rb,2.90265e-08_rb/)
+      totplnkderiv(101:150,  1) = (/ &
+      2.90445e-08_rb,2.90905e-08_rb,2.91425e-08_rb,2.91560e-08_rb,2.91970e-08_rb, &
+      2.91905e-08_rb,2.92880e-08_rb,2.92950e-08_rb,2.93630e-08_rb,2.93995e-08_rb, &
+      2.94425e-08_rb,2.94635e-08_rb,2.94770e-08_rb,2.95290e-08_rb,2.95585e-08_rb, &
+      2.95815e-08_rb,2.95995e-08_rb,2.96745e-08_rb,2.96725e-08_rb,2.97040e-08_rb, &
+      2.97750e-08_rb,2.97905e-08_rb,2.98175e-08_rb,2.98355e-08_rb,2.98705e-08_rb, &
+      2.99040e-08_rb,2.99680e-08_rb,2.99860e-08_rb,3.00270e-08_rb,3.00200e-08_rb, &
+      3.00770e-08_rb,3.00795e-08_rb,3.01065e-08_rb,3.01795e-08_rb,3.01815e-08_rb, &
+      3.02025e-08_rb,3.02360e-08_rb,3.02360e-08_rb,3.03090e-08_rb,3.03155e-08_rb, &
+      3.03725e-08_rb,3.03635e-08_rb,3.04270e-08_rb,3.04610e-08_rb,3.04635e-08_rb, &
+      3.04610e-08_rb,3.05180e-08_rb,3.05430e-08_rb,3.05290e-08_rb,3.05885e-08_rb/)
+      totplnkderiv(151:181,  1) = (/ &
+      3.05750e-08_rb,3.05775e-08_rb,3.06795e-08_rb,3.07025e-08_rb,3.07365e-08_rb, &
+      3.07435e-08_rb,3.07525e-08_rb,3.07680e-08_rb,3.08115e-08_rb,3.07930e-08_rb, &
+      3.08155e-08_rb,3.08660e-08_rb,3.08865e-08_rb,3.08390e-08_rb,3.09340e-08_rb, &
+      3.09685e-08_rb,3.09340e-08_rb,3.09820e-08_rb,3.10365e-08_rb,3.10705e-08_rb, &
+      3.10750e-08_rb,3.10475e-08_rb,3.11685e-08_rb,3.11455e-08_rb,3.11500e-08_rb, &
+      3.11775e-08_rb,3.11890e-08_rb,3.12045e-08_rb,3.12185e-08_rb,3.12415e-08_rb, &
+      3.12590e-08_rb/)
+      totplnkderiv(1:50,  2) = (/ &
+      4.91150e-08_rb,4.97290e-08_rb,5.03415e-08_rb,5.09460e-08_rb,5.15550e-08_rb, &
+      5.21540e-08_rb,5.27575e-08_rb,5.33500e-08_rb,5.39500e-08_rb,5.45445e-08_rb, &
+      5.51290e-08_rb,5.57235e-08_rb,5.62955e-08_rb,5.68800e-08_rb,5.74620e-08_rb, &
+      5.80425e-08_rb,5.86145e-08_rb,5.91810e-08_rb,5.97435e-08_rb,6.03075e-08_rb, &
+      6.08625e-08_rb,6.14135e-08_rb,6.19775e-08_rb,6.25185e-08_rb,6.30675e-08_rb, &
+      6.36145e-08_rb,6.41535e-08_rb,6.46920e-08_rb,6.52265e-08_rb,6.57470e-08_rb, &
+      6.62815e-08_rb,6.68000e-08_rb,6.73320e-08_rb,6.78550e-08_rb,6.83530e-08_rb, &
+      6.88760e-08_rb,6.93735e-08_rb,6.98790e-08_rb,7.03950e-08_rb,7.08810e-08_rb, &
+      7.13815e-08_rb,7.18795e-08_rb,7.23415e-08_rb,7.28505e-08_rb,7.33285e-08_rb, &
+      7.38075e-08_rb,7.42675e-08_rb,7.47605e-08_rb,7.52380e-08_rb,7.57020e-08_rb/)
+      totplnkderiv(51:100,  2) = (/ &
+      7.61495e-08_rb,7.65955e-08_rb,7.70565e-08_rb,7.75185e-08_rb,7.79735e-08_rb, &
+      7.83915e-08_rb,7.88625e-08_rb,7.93215e-08_rb,7.97425e-08_rb,8.02195e-08_rb, &
+      8.05905e-08_rb,8.10335e-08_rb,8.14770e-08_rb,8.19025e-08_rb,8.22955e-08_rb, &
+      8.27115e-08_rb,8.31165e-08_rb,8.35645e-08_rb,8.39440e-08_rb,8.43785e-08_rb, &
+      8.47380e-08_rb,8.51495e-08_rb,8.55405e-08_rb,8.59720e-08_rb,8.63135e-08_rb, &
+      8.67065e-08_rb,8.70930e-08_rb,8.74545e-08_rb,8.78780e-08_rb,8.82160e-08_rb, &
+      8.85625e-08_rb,8.89850e-08_rb,8.93395e-08_rb,8.97080e-08_rb,9.00675e-08_rb, &
+      9.04085e-08_rb,9.07360e-08_rb,9.11315e-08_rb,9.13815e-08_rb,9.18320e-08_rb, &
+      9.21500e-08_rb,9.24725e-08_rb,9.28640e-08_rb,9.31955e-08_rb,9.35185e-08_rb, &
+      9.38645e-08_rb,9.41780e-08_rb,9.45465e-08_rb,9.48470e-08_rb,9.51375e-08_rb/)
+      totplnkderiv(101:150,  2) = (/ &
+      9.55245e-08_rb,9.57925e-08_rb,9.61195e-08_rb,9.64750e-08_rb,9.68110e-08_rb, &
+      9.71715e-08_rb,9.74150e-08_rb,9.77250e-08_rb,9.79600e-08_rb,9.82600e-08_rb, &
+      9.85300e-08_rb,9.88400e-08_rb,9.91600e-08_rb,9.95350e-08_rb,9.97500e-08_rb, &
+      1.00090e-07_rb,1.00370e-07_rb,1.00555e-07_rb,1.00935e-07_rb,1.01275e-07_rb, &
+      1.01400e-07_rb,1.01790e-07_rb,1.01945e-07_rb,1.02225e-07_rb,1.02585e-07_rb, &
+      1.02895e-07_rb,1.03010e-07_rb,1.03285e-07_rb,1.03540e-07_rb,1.03890e-07_rb, &
+      1.04015e-07_rb,1.04420e-07_rb,1.04640e-07_rb,1.04810e-07_rb,1.05090e-07_rb, &
+      1.05385e-07_rb,1.05600e-07_rb,1.05965e-07_rb,1.06050e-07_rb,1.06385e-07_rb, &
+      1.06390e-07_rb,1.06795e-07_rb,1.06975e-07_rb,1.07240e-07_rb,1.07435e-07_rb, &
+      1.07815e-07_rb,1.07960e-07_rb,1.08010e-07_rb,1.08535e-07_rb,1.08670e-07_rb/)
+      totplnkderiv(151:181,  2) = (/ &
+      1.08855e-07_rb,1.09210e-07_rb,1.09195e-07_rb,1.09510e-07_rb,1.09665e-07_rb, &
+      1.09885e-07_rb,1.10130e-07_rb,1.10440e-07_rb,1.10640e-07_rb,1.10760e-07_rb, &
+      1.11125e-07_rb,1.11195e-07_rb,1.11345e-07_rb,1.11710e-07_rb,1.11765e-07_rb, &
+      1.11960e-07_rb,1.12225e-07_rb,1.12460e-07_rb,1.12595e-07_rb,1.12730e-07_rb, &
+      1.12880e-07_rb,1.13295e-07_rb,1.13215e-07_rb,1.13505e-07_rb,1.13665e-07_rb, &
+      1.13870e-07_rb,1.14025e-07_rb,1.14325e-07_rb,1.14495e-07_rb,1.14605e-07_rb, &
+      1.14905e-07_rb/)
+      totplnkderiv(1:50, 3) = (/ &
+      4.27040e-08_rb,4.35430e-08_rb,4.43810e-08_rb,4.52210e-08_rb,4.60630e-08_rb, &
+      4.69135e-08_rb,4.77585e-08_rb,4.86135e-08_rb,4.94585e-08_rb,5.03230e-08_rb, &
+      5.11740e-08_rb,5.20250e-08_rb,5.28940e-08_rb,5.37465e-08_rb,5.46175e-08_rb, &
+      5.54700e-08_rb,5.63430e-08_rb,5.72085e-08_rb,5.80735e-08_rb,5.89430e-08_rb, &
+      5.98015e-08_rb,6.06680e-08_rb,6.15380e-08_rb,6.24130e-08_rb,6.32755e-08_rb, &
+      6.41340e-08_rb,6.50060e-08_rb,6.58690e-08_rb,6.67315e-08_rb,6.76025e-08_rb, &
+      6.84585e-08_rb,6.93205e-08_rb,7.01845e-08_rb,7.10485e-08_rb,7.19160e-08_rb, &
+      7.27695e-08_rb,7.36145e-08_rb,7.44840e-08_rb,7.53405e-08_rb,7.61770e-08_rb, &
+      7.70295e-08_rb,7.78745e-08_rb,7.87350e-08_rb,7.95740e-08_rb,8.04150e-08_rb, &
+      8.12565e-08_rb,8.20885e-08_rb,8.29455e-08_rb,8.37830e-08_rb,8.46035e-08_rb/)
+      totplnkderiv(51:100, 3) = (/ &
+      8.54315e-08_rb,8.62770e-08_rb,8.70975e-08_rb,8.79140e-08_rb,8.87190e-08_rb, &
+      8.95625e-08_rb,9.03625e-08_rb,9.11795e-08_rb,9.19930e-08_rb,9.27685e-08_rb, &
+      9.36095e-08_rb,9.43785e-08_rb,9.52375e-08_rb,9.59905e-08_rb,9.67680e-08_rb, &
+      9.75840e-08_rb,9.83755e-08_rb,9.91710e-08_rb,9.99445e-08_rb,1.00706e-07_rb, &
+      1.01477e-07_rb,1.02255e-07_rb,1.03021e-07_rb,1.03776e-07_rb,1.04544e-07_rb, &
+      1.05338e-07_rb,1.06082e-07_rb,1.06843e-07_rb,1.07543e-07_rb,1.08298e-07_rb, &
+      1.09103e-07_rb,1.09812e-07_rb,1.10536e-07_rb,1.11268e-07_rb,1.12027e-07_rb, &
+      1.12727e-07_rb,1.13464e-07_rb,1.14183e-07_rb,1.15037e-07_rb,1.15615e-07_rb, &
+      1.16329e-07_rb,1.17057e-07_rb,1.17734e-07_rb,1.18448e-07_rb,1.19149e-07_rb, &
+      1.19835e-07_rb,1.20512e-07_rb,1.21127e-07_rb,1.21895e-07_rb,1.22581e-07_rb/)
+      totplnkderiv(101:150, 3) = (/ &
+      1.23227e-07_rb,1.23928e-07_rb,1.24560e-07_rb,1.25220e-07_rb,1.25895e-07_rb, &
+      1.26565e-07_rb,1.27125e-07_rb,1.27855e-07_rb,1.28490e-07_rb,1.29195e-07_rb, &
+      1.29790e-07_rb,1.30470e-07_rb,1.31070e-07_rb,1.31690e-07_rb,1.32375e-07_rb, &
+      1.32960e-07_rb,1.33570e-07_rb,1.34230e-07_rb,1.34840e-07_rb,1.35315e-07_rb, &
+      1.35990e-07_rb,1.36555e-07_rb,1.37265e-07_rb,1.37945e-07_rb,1.38425e-07_rb, &
+      1.38950e-07_rb,1.39640e-07_rb,1.40220e-07_rb,1.40775e-07_rb,1.41400e-07_rb, &
+      1.42020e-07_rb,1.42500e-07_rb,1.43085e-07_rb,1.43680e-07_rb,1.44255e-07_rb, &
+      1.44855e-07_rb,1.45385e-07_rb,1.45890e-07_rb,1.46430e-07_rb,1.46920e-07_rb, &
+      1.47715e-07_rb,1.48090e-07_rb,1.48695e-07_rb,1.49165e-07_rb,1.49715e-07_rb, &
+      1.50130e-07_rb,1.50720e-07_rb,1.51330e-07_rb,1.51725e-07_rb,1.52350e-07_rb/)
+      totplnkderiv(151:181, 3) = (/ &
+      1.52965e-07_rb,1.53305e-07_rb,1.53915e-07_rb,1.54280e-07_rb,1.54950e-07_rb, &
+      1.55370e-07_rb,1.55850e-07_rb,1.56260e-07_rb,1.56825e-07_rb,1.57470e-07_rb, &
+      1.57760e-07_rb,1.58295e-07_rb,1.58780e-07_rb,1.59470e-07_rb,1.59940e-07_rb, &
+      1.60325e-07_rb,1.60825e-07_rb,1.61100e-07_rb,1.61605e-07_rb,1.62045e-07_rb, &
+      1.62670e-07_rb,1.63020e-07_rb,1.63625e-07_rb,1.63900e-07_rb,1.64420e-07_rb, &
+      1.64705e-07_rb,1.65430e-07_rb,1.65610e-07_rb,1.66220e-07_rb,1.66585e-07_rb, &
+      1.66965e-07_rb/)
+      totplnkderiv(1:50, 4) = (/ &
+      3.32829e-08_rb,3.41160e-08_rb,3.49626e-08_rb,3.58068e-08_rb,3.66765e-08_rb, &
+      3.75320e-08_rb,3.84095e-08_rb,3.92920e-08_rb,4.01830e-08_rb,4.10715e-08_rb, &
+      4.19735e-08_rb,4.28835e-08_rb,4.37915e-08_rb,4.47205e-08_rb,4.56410e-08_rb, &
+      4.65770e-08_rb,4.75090e-08_rb,4.84530e-08_rb,4.93975e-08_rb,5.03470e-08_rb, &
+      5.13000e-08_rb,5.22560e-08_rb,5.32310e-08_rb,5.41865e-08_rb,5.51655e-08_rb, &
+      5.61590e-08_rb,5.71120e-08_rb,5.81075e-08_rb,5.91060e-08_rb,6.00895e-08_rb, &
+      6.10750e-08_rb,6.20740e-08_rb,6.30790e-08_rb,6.40765e-08_rb,6.50940e-08_rb, &
+      6.60895e-08_rb,6.71230e-08_rb,6.81200e-08_rb,6.91260e-08_rb,7.01485e-08_rb, &
+      7.11625e-08_rb,7.21870e-08_rb,7.32010e-08_rb,7.42080e-08_rb,7.52285e-08_rb, &
+      7.62930e-08_rb,7.73040e-08_rb,7.83185e-08_rb,7.93410e-08_rb,8.03560e-08_rb/)
+      totplnkderiv(51:100, 4) = (/ &
+      8.14115e-08_rb,8.24200e-08_rb,8.34555e-08_rb,8.45100e-08_rb,8.55265e-08_rb, &
+      8.65205e-08_rb,8.75615e-08_rb,8.85870e-08_rb,8.96175e-08_rb,9.07015e-08_rb, &
+      9.16475e-08_rb,9.27525e-08_rb,9.37055e-08_rb,9.47375e-08_rb,9.57995e-08_rb, &
+      9.67635e-08_rb,9.77980e-08_rb,9.87735e-08_rb,9.98485e-08_rb,1.00904e-07_rb, &
+      1.01900e-07_rb,1.02876e-07_rb,1.03905e-07_rb,1.04964e-07_rb,1.05956e-07_rb, &
+      1.06870e-07_rb,1.07952e-07_rb,1.08944e-07_rb,1.10003e-07_rb,1.10965e-07_rb, &
+      1.11952e-07_rb,1.12927e-07_rb,1.13951e-07_rb,1.14942e-07_rb,1.15920e-07_rb, &
+      1.16968e-07_rb,1.17877e-07_rb,1.18930e-07_rb,1.19862e-07_rb,1.20817e-07_rb, &
+      1.21817e-07_rb,1.22791e-07_rb,1.23727e-07_rb,1.24751e-07_rb,1.25697e-07_rb, &
+      1.26634e-07_rb,1.27593e-07_rb,1.28585e-07_rb,1.29484e-07_rb,1.30485e-07_rb/)
+      totplnkderiv(101:150, 4) = (/ &
+      1.31363e-07_rb,1.32391e-07_rb,1.33228e-07_rb,1.34155e-07_rb,1.35160e-07_rb, &
+      1.36092e-07_rb,1.37070e-07_rb,1.37966e-07_rb,1.38865e-07_rb,1.39740e-07_rb, &
+      1.40770e-07_rb,1.41620e-07_rb,1.42605e-07_rb,1.43465e-07_rb,1.44240e-07_rb, &
+      1.45305e-07_rb,1.46220e-07_rb,1.47070e-07_rb,1.47935e-07_rb,1.48890e-07_rb, &
+      1.49905e-07_rb,1.50640e-07_rb,1.51435e-07_rb,1.52335e-07_rb,1.53235e-07_rb, &
+      1.54045e-07_rb,1.54895e-07_rb,1.55785e-07_rb,1.56870e-07_rb,1.57360e-07_rb, &
+      1.58395e-07_rb,1.59185e-07_rb,1.60060e-07_rb,1.60955e-07_rb,1.61770e-07_rb, &
+      1.62445e-07_rb,1.63415e-07_rb,1.64170e-07_rb,1.65125e-07_rb,1.65995e-07_rb, &
+      1.66545e-07_rb,1.67580e-07_rb,1.68295e-07_rb,1.69130e-07_rb,1.69935e-07_rb, &
+      1.70800e-07_rb,1.71610e-07_rb,1.72365e-07_rb,1.73215e-07_rb,1.73770e-07_rb/)
+      totplnkderiv(151:181, 4) = (/ &
+      1.74590e-07_rb,1.75525e-07_rb,1.76095e-07_rb,1.77125e-07_rb,1.77745e-07_rb, &
+      1.78580e-07_rb,1.79315e-07_rb,1.80045e-07_rb,1.80695e-07_rb,1.81580e-07_rb, &
+      1.82360e-07_rb,1.83205e-07_rb,1.84055e-07_rb,1.84315e-07_rb,1.85225e-07_rb, &
+      1.85865e-07_rb,1.86660e-07_rb,1.87445e-07_rb,1.88350e-07_rb,1.88930e-07_rb, &
+      1.89420e-07_rb,1.90275e-07_rb,1.90630e-07_rb,1.91650e-07_rb,1.92485e-07_rb, &
+      1.93285e-07_rb,1.93695e-07_rb,1.94595e-07_rb,1.94895e-07_rb,1.95960e-07_rb, &
+      1.96525e-07_rb/)
+      totplnkderiv(1:50, 5) = (/ &
+      2.41948e-08_rb,2.49273e-08_rb,2.56705e-08_rb,2.64263e-08_rb,2.71899e-08_rb, &
+      2.79687e-08_rb,2.87531e-08_rb,2.95520e-08_rb,3.03567e-08_rb,3.11763e-08_rb, &
+      3.20014e-08_rb,3.28390e-08_rb,3.36865e-08_rb,3.45395e-08_rb,3.54083e-08_rb, &
+      3.62810e-08_rb,3.71705e-08_rb,3.80585e-08_rb,3.89650e-08_rb,3.98750e-08_rb, &
+      4.07955e-08_rb,4.17255e-08_rb,4.26635e-08_rb,4.36095e-08_rb,4.45605e-08_rb, &
+      4.55190e-08_rb,4.64910e-08_rb,4.74670e-08_rb,4.84480e-08_rb,4.94430e-08_rb, &
+      5.04460e-08_rb,5.14440e-08_rb,5.24500e-08_rb,5.34835e-08_rb,5.44965e-08_rb, &
+      5.55325e-08_rb,5.65650e-08_rb,5.76050e-08_rb,5.86615e-08_rb,5.97175e-08_rb, &
+      6.07750e-08_rb,6.18400e-08_rb,6.29095e-08_rb,6.39950e-08_rb,6.50665e-08_rb, &
+      6.61405e-08_rb,6.72290e-08_rb,6.82800e-08_rb,6.94445e-08_rb,7.05460e-08_rb/)
+      totplnkderiv(51:100, 5) = (/ &
+      7.16400e-08_rb,7.27475e-08_rb,7.38790e-08_rb,7.49845e-08_rb,7.61270e-08_rb, &
+      7.72375e-08_rb,7.83770e-08_rb,7.95045e-08_rb,8.06315e-08_rb,8.17715e-08_rb, &
+      8.29275e-08_rb,8.40555e-08_rb,8.52110e-08_rb,8.63565e-08_rb,8.75045e-08_rb, &
+      8.86735e-08_rb,8.98150e-08_rb,9.09970e-08_rb,9.21295e-08_rb,9.32730e-08_rb, &
+      9.44605e-08_rb,9.56170e-08_rb,9.67885e-08_rb,9.79275e-08_rb,9.91190e-08_rb, &
+      1.00278e-07_rb,1.01436e-07_rb,1.02625e-07_rb,1.03792e-07_rb,1.04989e-07_rb, &
+      1.06111e-07_rb,1.07320e-07_rb,1.08505e-07_rb,1.09626e-07_rb,1.10812e-07_rb, &
+      1.11948e-07_rb,1.13162e-07_rb,1.14289e-07_rb,1.15474e-07_rb,1.16661e-07_rb, &
+      1.17827e-07_rb,1.19023e-07_rb,1.20167e-07_rb,1.21356e-07_rb,1.22499e-07_rb, &
+      1.23653e-07_rb,1.24876e-07_rb,1.25983e-07_rb,1.27175e-07_rb,1.28325e-07_rb/)
+      totplnkderiv(101:150, 5) = (/ &
+      1.29517e-07_rb,1.30685e-07_rb,1.31840e-07_rb,1.33013e-07_rb,1.34160e-07_rb, &
+      1.35297e-07_rb,1.36461e-07_rb,1.37630e-07_rb,1.38771e-07_rb,1.39913e-07_rb, &
+      1.41053e-07_rb,1.42218e-07_rb,1.43345e-07_rb,1.44460e-07_rb,1.45692e-07_rb, &
+      1.46697e-07_rb,1.47905e-07_rb,1.49010e-07_rb,1.50210e-07_rb,1.51285e-07_rb, &
+      1.52380e-07_rb,1.53555e-07_rb,1.54655e-07_rb,1.55805e-07_rb,1.56850e-07_rb, &
+      1.58055e-07_rb,1.59115e-07_rb,1.60185e-07_rb,1.61255e-07_rb,1.62465e-07_rb, &
+      1.63575e-07_rb,1.64675e-07_rb,1.65760e-07_rb,1.66765e-07_rb,1.67945e-07_rb, &
+      1.69070e-07_rb,1.70045e-07_rb,1.71145e-07_rb,1.72260e-07_rb,1.73290e-07_rb, &
+      1.74470e-07_rb,1.75490e-07_rb,1.76515e-07_rb,1.77555e-07_rb,1.78660e-07_rb, &
+      1.79670e-07_rb,1.80705e-07_rb,1.81895e-07_rb,1.82745e-07_rb,1.83950e-07_rb/)
+      totplnkderiv(151:181, 5) = (/ &
+      1.84955e-07_rb,1.85940e-07_rb,1.87080e-07_rb,1.88010e-07_rb,1.89145e-07_rb, &
+      1.90130e-07_rb,1.91110e-07_rb,1.92130e-07_rb,1.93205e-07_rb,1.94230e-07_rb, &
+      1.95045e-07_rb,1.96070e-07_rb,1.97155e-07_rb,1.98210e-07_rb,1.99080e-07_rb, &
+      2.00280e-07_rb,2.01135e-07_rb,2.02150e-07_rb,2.03110e-07_rb,2.04135e-07_rb, &
+      2.05110e-07_rb,2.06055e-07_rb,2.07120e-07_rb,2.08075e-07_rb,2.08975e-07_rb, &
+      2.09950e-07_rb,2.10870e-07_rb,2.11830e-07_rb,2.12960e-07_rb,2.13725e-07_rb, &
+      2.14765e-07_rb/)
+      totplnkderiv(1:50, 6) = (/ &
+      1.36567e-08_rb,1.41766e-08_rb,1.47079e-08_rb,1.52499e-08_rb,1.58075e-08_rb, &
+      1.63727e-08_rb,1.69528e-08_rb,1.75429e-08_rb,1.81477e-08_rb,1.87631e-08_rb, &
+      1.93907e-08_rb,2.00297e-08_rb,2.06808e-08_rb,2.13432e-08_rb,2.20183e-08_rb, &
+      2.27076e-08_rb,2.34064e-08_rb,2.41181e-08_rb,2.48400e-08_rb,2.55750e-08_rb, &
+      2.63231e-08_rb,2.70790e-08_rb,2.78502e-08_rb,2.86326e-08_rb,2.94259e-08_rb, &
+      3.02287e-08_rb,3.10451e-08_rb,3.18752e-08_rb,3.27108e-08_rb,3.35612e-08_rb, &
+      3.44198e-08_rb,3.52930e-08_rb,3.61785e-08_rb,3.70690e-08_rb,3.79725e-08_rb, &
+      3.88845e-08_rb,3.98120e-08_rb,4.07505e-08_rb,4.16965e-08_rb,4.26515e-08_rb, &
+      4.36190e-08_rb,4.45925e-08_rb,4.55760e-08_rb,4.65735e-08_rb,4.75835e-08_rb, &
+      4.85970e-08_rb,4.96255e-08_rb,5.06975e-08_rb,5.16950e-08_rb,5.27530e-08_rb/)
+      totplnkderiv(51:100, 6) = (/ &
+      5.38130e-08_rb,5.48860e-08_rb,5.59715e-08_rb,5.70465e-08_rb,5.81385e-08_rb, &
+      5.92525e-08_rb,6.03565e-08_rb,6.14815e-08_rb,6.26175e-08_rb,6.37475e-08_rb, &
+      6.48855e-08_rb,6.60340e-08_rb,6.71980e-08_rb,6.83645e-08_rb,6.95430e-08_rb, &
+      7.07145e-08_rb,7.19015e-08_rb,7.30995e-08_rb,7.43140e-08_rb,7.55095e-08_rb, &
+      7.67115e-08_rb,7.79485e-08_rb,7.91735e-08_rb,8.03925e-08_rb,8.16385e-08_rb, &
+      8.28775e-08_rb,8.41235e-08_rb,8.53775e-08_rb,8.66405e-08_rb,8.78940e-08_rb, &
+      8.91805e-08_rb,9.04515e-08_rb,9.17290e-08_rb,9.30230e-08_rb,9.43145e-08_rb, &
+      9.56200e-08_rb,9.69160e-08_rb,9.82140e-08_rb,9.95285e-08_rb,1.00829e-07_rb, &
+      1.02145e-07_rb,1.03478e-07_rb,1.04787e-07_rb,1.06095e-07_rb,1.07439e-07_rb, &
+      1.08785e-07_rb,1.10078e-07_rb,1.11466e-07_rb,1.12795e-07_rb,1.14133e-07_rb/)
+      totplnkderiv(101:150, 6) = (/ &
+      1.15479e-07_rb,1.16825e-07_rb,1.18191e-07_rb,1.19540e-07_rb,1.20908e-07_rb, &
+      1.22257e-07_rb,1.23634e-07_rb,1.24992e-07_rb,1.26345e-07_rb,1.27740e-07_rb, &
+      1.29098e-07_rb,1.30447e-07_rb,1.31831e-07_rb,1.33250e-07_rb,1.34591e-07_rb, &
+      1.36011e-07_rb,1.37315e-07_rb,1.38721e-07_rb,1.40103e-07_rb,1.41504e-07_rb, &
+      1.42882e-07_rb,1.44259e-07_rb,1.45674e-07_rb,1.46997e-07_rb,1.48412e-07_rb, &
+      1.49794e-07_rb,1.51167e-07_rb,1.52577e-07_rb,1.53941e-07_rb,1.55369e-07_rb, &
+      1.56725e-07_rb,1.58125e-07_rb,1.59460e-07_rb,1.60895e-07_rb,1.62260e-07_rb, &
+      1.63610e-07_rb,1.65085e-07_rb,1.66410e-07_rb,1.67805e-07_rb,1.69185e-07_rb, &
+      1.70570e-07_rb,1.71915e-07_rb,1.73375e-07_rb,1.74775e-07_rb,1.76090e-07_rb, &
+      1.77485e-07_rb,1.78905e-07_rb,1.80190e-07_rb,1.81610e-07_rb,1.82960e-07_rb/)
+      totplnkderiv(151:181, 6) = (/ &
+      1.84330e-07_rb,1.85750e-07_rb,1.87060e-07_rb,1.88470e-07_rb,1.89835e-07_rb, &
+      1.91250e-07_rb,1.92565e-07_rb,1.93925e-07_rb,1.95220e-07_rb,1.96620e-07_rb, &
+      1.98095e-07_rb,1.99330e-07_rb,2.00680e-07_rb,2.02090e-07_rb,2.03360e-07_rb, &
+      2.04775e-07_rb,2.06080e-07_rb,2.07440e-07_rb,2.08820e-07_rb,2.10095e-07_rb, &
+      2.11445e-07_rb,2.12785e-07_rb,2.14050e-07_rb,2.15375e-07_rb,2.16825e-07_rb, &
+      2.18080e-07_rb,2.19345e-07_rb,2.20710e-07_rb,2.21980e-07_rb,2.23425e-07_rb, &
+      2.24645e-07_rb/)
+      totplnkderiv(1:50, 7) = (/ &
+      7.22270e-09_rb,7.55350e-09_rb,7.89480e-09_rb,8.24725e-09_rb,8.60780e-09_rb, &
+      8.98215e-09_rb,9.36430e-09_rb,9.76035e-09_rb,1.01652e-08_rb,1.05816e-08_rb, &
+      1.10081e-08_rb,1.14480e-08_rb,1.18981e-08_rb,1.23600e-08_rb,1.28337e-08_rb, &
+      1.33172e-08_rb,1.38139e-08_rb,1.43208e-08_rb,1.48413e-08_rb,1.53702e-08_rb, &
+      1.59142e-08_rb,1.64704e-08_rb,1.70354e-08_rb,1.76178e-08_rb,1.82065e-08_rb, &
+      1.88083e-08_rb,1.94237e-08_rb,2.00528e-08_rb,2.06913e-08_rb,2.13413e-08_rb, &
+      2.20058e-08_rb,2.26814e-08_rb,2.33686e-08_rb,2.40729e-08_rb,2.47812e-08_rb, &
+      2.55099e-08_rb,2.62449e-08_rb,2.69966e-08_rb,2.77569e-08_rb,2.85269e-08_rb, &
+      2.93144e-08_rb,3.01108e-08_rb,3.09243e-08_rb,3.17433e-08_rb,3.25756e-08_rb, &
+      3.34262e-08_rb,3.42738e-08_rb,3.51480e-08_rb,3.60285e-08_rb,3.69160e-08_rb/)
+      totplnkderiv(51:100, 7) = (/ &
+      3.78235e-08_rb,3.87390e-08_rb,3.96635e-08_rb,4.06095e-08_rb,4.15600e-08_rb, &
+      4.25180e-08_rb,4.34895e-08_rb,4.44800e-08_rb,4.54715e-08_rb,4.64750e-08_rb, &
+      4.74905e-08_rb,4.85210e-08_rb,4.95685e-08_rb,5.06135e-08_rb,5.16725e-08_rb, &
+      5.27480e-08_rb,5.38265e-08_rb,5.49170e-08_rb,5.60120e-08_rb,5.71275e-08_rb, &
+      5.82610e-08_rb,5.93775e-08_rb,6.05245e-08_rb,6.17025e-08_rb,6.28355e-08_rb, &
+      6.40135e-08_rb,6.52015e-08_rb,6.63865e-08_rb,6.75790e-08_rb,6.88120e-08_rb, &
+      7.00070e-08_rb,7.12335e-08_rb,7.24720e-08_rb,7.37340e-08_rb,7.49775e-08_rb, &
+      7.62415e-08_rb,7.75185e-08_rb,7.87915e-08_rb,8.00875e-08_rb,8.13630e-08_rb, &
+      8.26710e-08_rb,8.39645e-08_rb,8.53060e-08_rb,8.66305e-08_rb,8.79915e-08_rb, &
+      8.93080e-08_rb,9.06560e-08_rb,9.19860e-08_rb,9.33550e-08_rb,9.47305e-08_rb/)
+      totplnkderiv(101:150, 7) = (/ &
+      9.61180e-08_rb,9.74500e-08_rb,9.88850e-08_rb,1.00263e-07_rb,1.01688e-07_rb, &
+      1.03105e-07_rb,1.04489e-07_rb,1.05906e-07_rb,1.07345e-07_rb,1.08771e-07_rb, &
+      1.10220e-07_rb,1.11713e-07_rb,1.13098e-07_rb,1.14515e-07_rb,1.16019e-07_rb, &
+      1.17479e-07_rb,1.18969e-07_rb,1.20412e-07_rb,1.21852e-07_rb,1.23387e-07_rb, &
+      1.24851e-07_rb,1.26319e-07_rb,1.27811e-07_rb,1.29396e-07_rb,1.30901e-07_rb, &
+      1.32358e-07_rb,1.33900e-07_rb,1.35405e-07_rb,1.36931e-07_rb,1.38443e-07_rb, &
+      1.39985e-07_rb,1.41481e-07_rb,1.43072e-07_rb,1.44587e-07_rb,1.46133e-07_rb, &
+      1.47698e-07_rb,1.49203e-07_rb,1.50712e-07_rb,1.52363e-07_rb,1.53795e-07_rb, &
+      1.55383e-07_rb,1.56961e-07_rb,1.58498e-07_rb,1.60117e-07_rb,1.61745e-07_rb, &
+      1.63190e-07_rb,1.64790e-07_rb,1.66370e-07_rb,1.67975e-07_rb,1.69555e-07_rb/)
+      totplnkderiv(151:181, 7) = (/ &
+      1.71060e-07_rb,1.72635e-07_rb,1.74345e-07_rb,1.75925e-07_rb,1.77395e-07_rb, &
+      1.78960e-07_rb,1.80620e-07_rb,1.82180e-07_rb,1.83840e-07_rb,1.85340e-07_rb, &
+      1.86940e-07_rb,1.88550e-07_rb,1.90095e-07_rb,1.91670e-07_rb,1.93385e-07_rb, &
+      1.94895e-07_rb,1.96500e-07_rb,1.98090e-07_rb,1.99585e-07_rb,2.01280e-07_rb, &
+      2.02950e-07_rb,2.04455e-07_rb,2.06075e-07_rb,2.07635e-07_rb,2.09095e-07_rb, &
+      2.10865e-07_rb,2.12575e-07_rb,2.14050e-07_rb,2.15630e-07_rb,2.17060e-07_rb, &
+      2.18715e-07_rb/)
+      totplnkderiv(1:50, 8) = (/ &
+      4.26397e-09_rb,4.48470e-09_rb,4.71299e-09_rb,4.94968e-09_rb,5.19542e-09_rb, &
+      5.44847e-09_rb,5.71195e-09_rb,5.98305e-09_rb,6.26215e-09_rb,6.55290e-09_rb, &
+      6.85190e-09_rb,7.15950e-09_rb,7.47745e-09_rb,7.80525e-09_rb,8.14190e-09_rb, &
+      8.48915e-09_rb,8.84680e-09_rb,9.21305e-09_rb,9.59105e-09_rb,9.98130e-09_rb, &
+      1.03781e-08_rb,1.07863e-08_rb,1.12094e-08_rb,1.16371e-08_rb,1.20802e-08_rb, &
+      1.25327e-08_rb,1.29958e-08_rb,1.34709e-08_rb,1.39592e-08_rb,1.44568e-08_rb, &
+      1.49662e-08_rb,1.54828e-08_rb,1.60186e-08_rb,1.65612e-08_rb,1.71181e-08_rb, &
+      1.76822e-08_rb,1.82591e-08_rb,1.88487e-08_rb,1.94520e-08_rb,2.00691e-08_rb, &
+      2.06955e-08_rb,2.13353e-08_rb,2.19819e-08_rb,2.26479e-08_rb,2.33234e-08_rb, &
+      2.40058e-08_rb,2.47135e-08_rb,2.54203e-08_rb,2.61414e-08_rb,2.68778e-08_rb/)
+      totplnkderiv(51:100, 8) = (/ &
+      2.76265e-08_rb,2.83825e-08_rb,2.91632e-08_rb,2.99398e-08_rb,3.07389e-08_rb, &
+      3.15444e-08_rb,3.23686e-08_rb,3.31994e-08_rb,3.40487e-08_rb,3.49020e-08_rb, &
+      3.57715e-08_rb,3.66515e-08_rb,3.75465e-08_rb,3.84520e-08_rb,3.93675e-08_rb, &
+      4.02985e-08_rb,4.12415e-08_rb,4.21965e-08_rb,4.31630e-08_rb,4.41360e-08_rb, &
+      4.51220e-08_rb,4.61235e-08_rb,4.71440e-08_rb,4.81515e-08_rb,4.91905e-08_rb, &
+      5.02395e-08_rb,5.12885e-08_rb,5.23735e-08_rb,5.34460e-08_rb,5.45245e-08_rb, &
+      5.56375e-08_rb,5.67540e-08_rb,5.78780e-08_rb,5.90065e-08_rb,6.01520e-08_rb, &
+      6.13000e-08_rb,6.24720e-08_rb,6.36530e-08_rb,6.48500e-08_rb,6.60500e-08_rb, &
+      6.72435e-08_rb,6.84735e-08_rb,6.97025e-08_rb,7.09530e-08_rb,7.21695e-08_rb, &
+      7.34270e-08_rb,7.47295e-08_rb,7.59915e-08_rb,7.72685e-08_rb,7.85925e-08_rb/)
+      totplnkderiv(101:150, 8) = (/ &
+      7.98855e-08_rb,8.12205e-08_rb,8.25120e-08_rb,8.38565e-08_rb,8.52005e-08_rb, &
+      8.65570e-08_rb,8.79075e-08_rb,8.92920e-08_rb,9.06535e-08_rb,9.20455e-08_rb, &
+      9.34230e-08_rb,9.48355e-08_rb,9.62720e-08_rb,9.76890e-08_rb,9.90755e-08_rb, &
+      1.00528e-07_rb,1.01982e-07_rb,1.03436e-07_rb,1.04919e-07_rb,1.06368e-07_rb, &
+      1.07811e-07_rb,1.09326e-07_rb,1.10836e-07_rb,1.12286e-07_rb,1.13803e-07_rb, &
+      1.15326e-07_rb,1.16809e-07_rb,1.18348e-07_rb,1.19876e-07_rb,1.21413e-07_rb, &
+      1.22922e-07_rb,1.24524e-07_rb,1.26049e-07_rb,1.27573e-07_rb,1.29155e-07_rb, &
+      1.30708e-07_rb,1.32327e-07_rb,1.33958e-07_rb,1.35480e-07_rb,1.37081e-07_rb, &
+      1.38716e-07_rb,1.40326e-07_rb,1.41872e-07_rb,1.43468e-07_rb,1.45092e-07_rb, &
+      1.46806e-07_rb,1.48329e-07_rb,1.49922e-07_rb,1.51668e-07_rb,1.53241e-07_rb/)
+      totplnkderiv(151:181, 8) = (/ &
+      1.54996e-07_rb,1.56561e-07_rb,1.58197e-07_rb,1.59884e-07_rb,1.61576e-07_rb, &
+      1.63200e-07_rb,1.64885e-07_rb,1.66630e-07_rb,1.68275e-07_rb,1.69935e-07_rb, &
+      1.71650e-07_rb,1.73245e-07_rb,1.75045e-07_rb,1.76710e-07_rb,1.78330e-07_rb, &
+      1.79995e-07_rb,1.81735e-07_rb,1.83470e-07_rb,1.85200e-07_rb,1.86890e-07_rb, &
+      1.88595e-07_rb,1.90300e-07_rb,1.91995e-07_rb,1.93715e-07_rb,1.95495e-07_rb, &
+      1.97130e-07_rb,1.98795e-07_rb,2.00680e-07_rb,2.02365e-07_rb,2.04090e-07_rb, &
+      2.05830e-07_rb/)
+      totplnkderiv(1:50, 9) = (/ &
+      1.85410e-09_rb,1.96515e-09_rb,2.08117e-09_rb,2.20227e-09_rb,2.32861e-09_rb, &
+      2.46066e-09_rb,2.59812e-09_rb,2.74153e-09_rb,2.89058e-09_rb,3.04567e-09_rb, &
+      3.20674e-09_rb,3.37442e-09_rb,3.54854e-09_rb,3.72892e-09_rb,3.91630e-09_rb, &
+      4.11013e-09_rb,4.31150e-09_rb,4.52011e-09_rb,4.73541e-09_rb,4.95870e-09_rb, &
+      5.18913e-09_rb,5.42752e-09_rb,5.67340e-09_rb,5.92810e-09_rb,6.18995e-09_rb, &
+      6.46055e-09_rb,6.73905e-09_rb,7.02620e-09_rb,7.32260e-09_rb,7.62700e-09_rb, &
+      7.94050e-09_rb,8.26370e-09_rb,8.59515e-09_rb,8.93570e-09_rb,9.28535e-09_rb, &
+      9.64575e-09_rb,1.00154e-08_rb,1.03944e-08_rb,1.07839e-08_rb,1.11832e-08_rb, &
+      1.15909e-08_rb,1.20085e-08_rb,1.24399e-08_rb,1.28792e-08_rb,1.33280e-08_rb, &
+      1.37892e-08_rb,1.42573e-08_rb,1.47408e-08_rb,1.52345e-08_rb,1.57371e-08_rb/)
+      totplnkderiv(51:100, 9) = (/ &
+      1.62496e-08_rb,1.67756e-08_rb,1.73101e-08_rb,1.78596e-08_rb,1.84161e-08_rb, &
+      1.89869e-08_rb,1.95681e-08_rb,2.01632e-08_rb,2.07626e-08_rb,2.13800e-08_rb, &
+      2.20064e-08_rb,2.26453e-08_rb,2.32970e-08_rb,2.39595e-08_rb,2.46340e-08_rb, &
+      2.53152e-08_rb,2.60158e-08_rb,2.67235e-08_rb,2.74471e-08_rb,2.81776e-08_rb, &
+      2.89233e-08_rb,2.96822e-08_rb,3.04488e-08_rb,3.12298e-08_rb,3.20273e-08_rb, &
+      3.28304e-08_rb,3.36455e-08_rb,3.44765e-08_rb,3.53195e-08_rb,3.61705e-08_rb, &
+      3.70385e-08_rb,3.79155e-08_rb,3.88065e-08_rb,3.97055e-08_rb,4.06210e-08_rb, &
+      4.15490e-08_rb,4.24825e-08_rb,4.34355e-08_rb,4.43920e-08_rb,4.53705e-08_rb, &
+      4.63560e-08_rb,4.73565e-08_rb,4.83655e-08_rb,4.93815e-08_rb,5.04180e-08_rb, &
+      5.14655e-08_rb,5.25175e-08_rb,5.35865e-08_rb,5.46720e-08_rb,5.57670e-08_rb/)
+      totplnkderiv(101:150, 9) = (/ &
+      5.68640e-08_rb,5.79825e-08_rb,5.91140e-08_rb,6.02515e-08_rb,6.13985e-08_rb, &
+      6.25525e-08_rb,6.37420e-08_rb,6.49220e-08_rb,6.61145e-08_rb,6.73185e-08_rb, &
+      6.85520e-08_rb,6.97760e-08_rb,7.10050e-08_rb,7.22650e-08_rb,7.35315e-08_rb, &
+      7.48035e-08_rb,7.60745e-08_rb,7.73740e-08_rb,7.86870e-08_rb,7.99845e-08_rb, &
+      8.13325e-08_rb,8.26615e-08_rb,8.40010e-08_rb,8.53640e-08_rb,8.67235e-08_rb, &
+      8.80960e-08_rb,8.95055e-08_rb,9.08945e-08_rb,9.23045e-08_rb,9.37100e-08_rb, &
+      9.51555e-08_rb,9.65630e-08_rb,9.80235e-08_rb,9.94920e-08_rb,1.00966e-07_rb, &
+      1.02434e-07_rb,1.03898e-07_rb,1.05386e-07_rb,1.06905e-07_rb,1.08418e-07_rb, &
+      1.09926e-07_rb,1.11454e-07_rb,1.13010e-07_rb,1.14546e-07_rb,1.16106e-07_rb, &
+      1.17652e-07_rb,1.19264e-07_rb,1.20817e-07_rb,1.22395e-07_rb,1.24024e-07_rb/)
+      totplnkderiv(151:181, 9) = (/ &
+      1.25585e-07_rb,1.27213e-07_rb,1.28817e-07_rb,1.30472e-07_rb,1.32088e-07_rb, &
+      1.33752e-07_rb,1.35367e-07_rb,1.37018e-07_rb,1.38698e-07_rb,1.40394e-07_rb, &
+      1.42026e-07_rb,1.43796e-07_rb,1.45438e-07_rb,1.47175e-07_rb,1.48866e-07_rb, &
+      1.50576e-07_rb,1.52281e-07_rb,1.54018e-07_rb,1.55796e-07_rb,1.57515e-07_rb, &
+      1.59225e-07_rb,1.60989e-07_rb,1.62754e-07_rb,1.64532e-07_rb,1.66285e-07_rb, &
+      1.68070e-07_rb,1.69870e-07_rb,1.71625e-07_rb,1.73440e-07_rb,1.75275e-07_rb, &
+      1.77040e-07_rb/)
+      totplnkderiv(1:50,10) = (/ &
+      7.14917e-10_rb,7.64833e-10_rb,8.17460e-10_rb,8.72980e-10_rb,9.31380e-10_rb, &
+      9.92940e-10_rb,1.05746e-09_rb,1.12555e-09_rb,1.19684e-09_rb,1.27162e-09_rb, &
+      1.35001e-09_rb,1.43229e-09_rb,1.51815e-09_rb,1.60831e-09_rb,1.70271e-09_rb, &
+      1.80088e-09_rb,1.90365e-09_rb,2.01075e-09_rb,2.12261e-09_rb,2.23924e-09_rb, &
+      2.36057e-09_rb,2.48681e-09_rb,2.61814e-09_rb,2.75506e-09_rb,2.89692e-09_rb, &
+      3.04423e-09_rb,3.19758e-09_rb,3.35681e-09_rb,3.52113e-09_rb,3.69280e-09_rb, &
+      3.86919e-09_rb,4.05205e-09_rb,4.24184e-09_rb,4.43877e-09_rb,4.64134e-09_rb, &
+      4.85088e-09_rb,5.06670e-09_rb,5.29143e-09_rb,5.52205e-09_rb,5.75980e-09_rb, &
+      6.00550e-09_rb,6.25840e-09_rb,6.51855e-09_rb,6.78800e-09_rb,7.06435e-09_rb, &
+      7.34935e-09_rb,7.64220e-09_rb,7.94470e-09_rb,8.25340e-09_rb,8.57030e-09_rb/)
+      totplnkderiv(51:100,10) = (/ &
+      8.89680e-09_rb,9.23255e-09_rb,9.57770e-09_rb,9.93045e-09_rb,1.02932e-08_rb, &
+      1.06649e-08_rb,1.10443e-08_rb,1.14348e-08_rb,1.18350e-08_rb,1.22463e-08_rb, &
+      1.26679e-08_rb,1.30949e-08_rb,1.35358e-08_rb,1.39824e-08_rb,1.44425e-08_rb, &
+      1.49126e-08_rb,1.53884e-08_rb,1.58826e-08_rb,1.63808e-08_rb,1.68974e-08_rb, &
+      1.74159e-08_rb,1.79447e-08_rb,1.84886e-08_rb,1.90456e-08_rb,1.96124e-08_rb, &
+      2.01863e-08_rb,2.07737e-08_rb,2.13720e-08_rb,2.19837e-08_rb,2.26044e-08_rb, &
+      2.32396e-08_rb,2.38856e-08_rb,2.45344e-08_rb,2.52055e-08_rb,2.58791e-08_rb, &
+      2.65706e-08_rb,2.72758e-08_rb,2.79852e-08_rb,2.87201e-08_rb,2.94518e-08_rb, &
+      3.02063e-08_rb,3.09651e-08_rb,3.17357e-08_rb,3.25235e-08_rb,3.33215e-08_rb, &
+      3.41285e-08_rb,3.49485e-08_rb,3.57925e-08_rb,3.66330e-08_rb,3.74765e-08_rb/)
+      totplnkderiv(101:150,10) = (/ &
+      3.83675e-08_rb,3.92390e-08_rb,4.01330e-08_rb,4.10340e-08_rb,4.19585e-08_rb, &
+      4.28815e-08_rb,4.38210e-08_rb,4.47770e-08_rb,4.57575e-08_rb,4.67325e-08_rb, &
+      4.77170e-08_rb,4.87205e-08_rb,4.97410e-08_rb,5.07620e-08_rb,5.18180e-08_rb, &
+      5.28540e-08_rb,5.39260e-08_rb,5.50035e-08_rb,5.60885e-08_rb,5.71900e-08_rb, &
+      5.82940e-08_rb,5.94380e-08_rb,6.05690e-08_rb,6.17185e-08_rb,6.28860e-08_rb, &
+      6.40670e-08_rb,6.52300e-08_rb,6.64225e-08_rb,6.76485e-08_rb,6.88715e-08_rb, &
+      7.00750e-08_rb,7.13760e-08_rb,7.25910e-08_rb,7.38860e-08_rb,7.51290e-08_rb, &
+      7.64420e-08_rb,7.77550e-08_rb,7.90725e-08_rb,8.03825e-08_rb,8.17330e-08_rb, &
+      8.30810e-08_rb,8.44330e-08_rb,8.57720e-08_rb,8.72115e-08_rb,8.85800e-08_rb, &
+      8.99945e-08_rb,9.13905e-08_rb,9.28345e-08_rb,9.42665e-08_rb,9.56765e-08_rb/)
+      totplnkderiv(151:181,10) = (/ &
+      9.72000e-08_rb,9.86780e-08_rb,1.00105e-07_rb,1.01616e-07_rb,1.03078e-07_rb, &
+      1.04610e-07_rb,1.06154e-07_rb,1.07639e-07_rb,1.09242e-07_rb,1.10804e-07_rb, &
+      1.12384e-07_rb,1.13871e-07_rb,1.15478e-07_rb,1.17066e-07_rb,1.18703e-07_rb, &
+      1.20294e-07_rb,1.21930e-07_rb,1.23543e-07_rb,1.25169e-07_rb,1.26806e-07_rb, &
+      1.28503e-07_rb,1.30233e-07_rb,1.31834e-07_rb,1.33596e-07_rb,1.35283e-07_rb, &
+      1.36947e-07_rb,1.38594e-07_rb,1.40362e-07_rb,1.42131e-07_rb,1.43823e-07_rb, &
+      1.45592e-07_rb/)
+      totplnkderiv(1:50,11) = (/ &
+      2.25919e-10_rb,2.43810e-10_rb,2.62866e-10_rb,2.83125e-10_rb,3.04676e-10_rb, &
+      3.27536e-10_rb,3.51796e-10_rb,3.77498e-10_rb,4.04714e-10_rb,4.33528e-10_rb, &
+      4.64000e-10_rb,4.96185e-10_rb,5.30165e-10_rb,5.65999e-10_rb,6.03749e-10_rb, &
+      6.43579e-10_rb,6.85479e-10_rb,7.29517e-10_rb,7.75810e-10_rb,8.24440e-10_rb, &
+      8.75520e-10_rb,9.29065e-10_rb,9.85175e-10_rb,1.04405e-09_rb,1.10562e-09_rb, &
+      1.17005e-09_rb,1.23742e-09_rb,1.30780e-09_rb,1.38141e-09_rb,1.45809e-09_rb, &
+      1.53825e-09_rb,1.62177e-09_rb,1.70884e-09_rb,1.79942e-09_rb,1.89390e-09_rb, &
+      1.99205e-09_rb,2.09429e-09_rb,2.20030e-09_rb,2.31077e-09_rb,2.42510e-09_rb, &
+      2.54410e-09_rb,2.66754e-09_rb,2.79529e-09_rb,2.92777e-09_rb,3.06498e-09_rb, &
+      3.20691e-09_rb,3.35450e-09_rb,3.50653e-09_rb,3.66427e-09_rb,3.82723e-09_rb/)
+      totplnkderiv(51:100,11) = (/ &
+      3.99549e-09_rb,4.16911e-09_rb,4.34892e-09_rb,4.53415e-09_rb,4.72504e-09_rb, &
+      4.92197e-09_rb,5.12525e-09_rb,5.33485e-09_rb,5.55085e-09_rb,5.77275e-09_rb, &
+      6.00105e-09_rb,6.23650e-09_rb,6.47855e-09_rb,6.72735e-09_rb,6.98325e-09_rb, &
+      7.24695e-09_rb,7.51730e-09_rb,7.79480e-09_rb,8.07975e-09_rb,8.37170e-09_rb, &
+      8.67195e-09_rb,8.98050e-09_rb,9.29575e-09_rb,9.61950e-09_rb,9.95150e-09_rb, &
+      1.02912e-08_rb,1.06397e-08_rb,1.09964e-08_rb,1.13611e-08_rb,1.17348e-08_rb, &
+      1.21158e-08_rb,1.25072e-08_rb,1.29079e-08_rb,1.33159e-08_rb,1.37342e-08_rb, &
+      1.41599e-08_rb,1.45966e-08_rb,1.50438e-08_rb,1.54964e-08_rb,1.59605e-08_rb, &
+      1.64337e-08_rb,1.69189e-08_rb,1.74134e-08_rb,1.79136e-08_rb,1.84272e-08_rb, &
+      1.89502e-08_rb,1.94845e-08_rb,2.00248e-08_rb,2.05788e-08_rb,2.11455e-08_rb/)
+      totplnkderiv(101:150,11) = (/ &
+      2.17159e-08_rb,2.23036e-08_rb,2.28983e-08_rb,2.35033e-08_rb,2.41204e-08_rb, &
+      2.47485e-08_rb,2.53860e-08_rb,2.60331e-08_rb,2.66891e-08_rb,2.73644e-08_rb, &
+      2.80440e-08_rb,2.87361e-08_rb,2.94412e-08_rb,3.01560e-08_rb,3.08805e-08_rb, &
+      3.16195e-08_rb,3.23690e-08_rb,3.31285e-08_rb,3.39015e-08_rb,3.46820e-08_rb, &
+      3.54770e-08_rb,3.62805e-08_rb,3.70960e-08_rb,3.79295e-08_rb,3.87715e-08_rb, &
+      3.96185e-08_rb,4.04860e-08_rb,4.13600e-08_rb,4.22500e-08_rb,4.31490e-08_rb, &
+      4.40610e-08_rb,4.49810e-08_rb,4.59205e-08_rb,4.68650e-08_rb,4.78260e-08_rb, &
+      4.87970e-08_rb,4.97790e-08_rb,5.07645e-08_rb,5.17730e-08_rb,5.27960e-08_rb, &
+      5.38285e-08_rb,5.48650e-08_rb,5.59205e-08_rb,5.69960e-08_rb,5.80690e-08_rb, &
+      5.91570e-08_rb,6.02640e-08_rb,6.13750e-08_rb,6.25015e-08_rb,6.36475e-08_rb/)
+      totplnkderiv(151:181,11) = (/ &
+      6.47950e-08_rb,6.59510e-08_rb,6.71345e-08_rb,6.83175e-08_rb,6.95250e-08_rb, &
+      7.07325e-08_rb,7.19490e-08_rb,7.31880e-08_rb,7.44315e-08_rb,7.56880e-08_rb, &
+      7.69500e-08_rb,7.82495e-08_rb,7.95330e-08_rb,8.08450e-08_rb,8.21535e-08_rb, &
+      8.34860e-08_rb,8.48330e-08_rb,8.61795e-08_rb,8.75480e-08_rb,8.89235e-08_rb, &
+      9.03060e-08_rb,9.17045e-08_rb,9.31140e-08_rb,9.45240e-08_rb,9.59720e-08_rb, &
+      9.74140e-08_rb,9.88825e-08_rb,1.00347e-07_rb,1.01825e-07_rb,1.03305e-07_rb, &
+      1.04826e-07_rb/)
+      totplnkderiv(1:50,12) = (/ &
+      2.91689e-11_rb,3.20300e-11_rb,3.51272e-11_rb,3.84803e-11_rb,4.21014e-11_rb, &
+      4.60107e-11_rb,5.02265e-11_rb,5.47685e-11_rb,5.96564e-11_rb,6.49111e-11_rb, &
+      7.05522e-11_rb,7.66060e-11_rb,8.30974e-11_rb,9.00441e-11_rb,9.74820e-11_rb, &
+      1.05435e-10_rb,1.13925e-10_rb,1.22981e-10_rb,1.32640e-10_rb,1.42933e-10_rb, &
+      1.53882e-10_rb,1.65527e-10_rb,1.77903e-10_rb,1.91054e-10_rb,2.05001e-10_rb, &
+      2.19779e-10_rb,2.35448e-10_rb,2.52042e-10_rb,2.69565e-10_rb,2.88128e-10_rb, &
+      3.07714e-10_rb,3.28370e-10_rb,3.50238e-10_rb,3.73235e-10_rb,3.97433e-10_rb, &
+      4.22964e-10_rb,4.49822e-10_rb,4.78042e-10_rb,5.07721e-10_rb,5.38915e-10_rb, &
+      5.71610e-10_rb,6.05916e-10_rb,6.41896e-10_rb,6.79600e-10_rb,7.19110e-10_rb, &
+      7.60455e-10_rb,8.03625e-10_rb,8.48870e-10_rb,8.96080e-10_rb,9.45490e-10_rb/)
+      totplnkderiv(51:100,12) = (/ &
+      9.96930e-10_rb,1.05071e-09_rb,1.10679e-09_rb,1.16521e-09_rb,1.22617e-09_rb, &
+      1.28945e-09_rb,1.35554e-09_rb,1.42427e-09_rb,1.49574e-09_rb,1.56984e-09_rb, &
+      1.64695e-09_rb,1.72715e-09_rb,1.81034e-09_rb,1.89656e-09_rb,1.98613e-09_rb, &
+      2.07898e-09_rb,2.17515e-09_rb,2.27498e-09_rb,2.37826e-09_rb,2.48517e-09_rb, &
+      2.59566e-09_rb,2.71004e-09_rb,2.82834e-09_rb,2.95078e-09_rb,3.07686e-09_rb, &
+      3.20739e-09_rb,3.34232e-09_rb,3.48162e-09_rb,3.62515e-09_rb,3.77337e-09_rb, &
+      3.92614e-09_rb,4.08317e-09_rb,4.24567e-09_rb,4.41272e-09_rb,4.58524e-09_rb, &
+      4.76245e-09_rb,4.94450e-09_rb,5.13235e-09_rb,5.32535e-09_rb,5.52415e-09_rb, &
+      5.72770e-09_rb,5.93815e-09_rb,6.15315e-09_rb,6.37525e-09_rb,6.60175e-09_rb, &
+      6.83485e-09_rb,7.07490e-09_rb,7.32060e-09_rb,7.57225e-09_rb,7.83035e-09_rb/)
+      totplnkderiv(101:150,12) = (/ &
+      8.09580e-09_rb,8.36620e-09_rb,8.64410e-09_rb,8.93110e-09_rb,9.22170e-09_rb, &
+      9.52055e-09_rb,9.82595e-09_rb,1.01399e-08_rb,1.04613e-08_rb,1.07878e-08_rb, &
+      1.11223e-08_rb,1.14667e-08_rb,1.18152e-08_rb,1.21748e-08_rb,1.25410e-08_rb, &
+      1.29147e-08_rb,1.32948e-08_rb,1.36858e-08_rb,1.40827e-08_rb,1.44908e-08_rb, &
+      1.49040e-08_rb,1.53284e-08_rb,1.57610e-08_rb,1.61995e-08_rb,1.66483e-08_rb, &
+      1.71068e-08_rb,1.75714e-08_rb,1.80464e-08_rb,1.85337e-08_rb,1.90249e-08_rb, &
+      1.95309e-08_rb,2.00407e-08_rb,2.05333e-08_rb,2.10929e-08_rb,2.16346e-08_rb, &
+      2.21829e-08_rb,2.27402e-08_rb,2.33112e-08_rb,2.38922e-08_rb,2.44802e-08_rb, &
+      2.50762e-08_rb,2.56896e-08_rb,2.63057e-08_rb,2.69318e-08_rb,2.75705e-08_rb, &
+      2.82216e-08_rb,2.88787e-08_rb,2.95505e-08_rb,3.02335e-08_rb,3.09215e-08_rb/)
+      totplnkderiv(151:181,12) = (/ &
+      3.16235e-08_rb,3.23350e-08_rb,3.30590e-08_rb,3.37960e-08_rb,3.45395e-08_rb, &
+      3.52955e-08_rb,3.60615e-08_rb,3.68350e-08_rb,3.76265e-08_rb,3.84255e-08_rb, &
+      3.92400e-08_rb,4.00485e-08_rb,4.08940e-08_rb,4.17310e-08_rb,4.25860e-08_rb, &
+      4.34585e-08_rb,4.43270e-08_rb,4.52220e-08_rb,4.61225e-08_rb,4.70345e-08_rb, &
+      4.79560e-08_rb,4.89000e-08_rb,4.98445e-08_rb,5.07985e-08_rb,5.17705e-08_rb, &
+      5.27575e-08_rb,5.37420e-08_rb,5.47495e-08_rb,5.57725e-08_rb,5.68105e-08_rb, &
+      5.78395e-08_rb/)
+      totplnkderiv(1:50,13) = (/ &
+      5.47482e-12_rb,6.09637e-12_rb,6.77874e-12_rb,7.52703e-12_rb,8.34784e-12_rb, &
+      9.24486e-12_rb,1.02246e-11_rb,1.12956e-11_rb,1.24615e-11_rb,1.37321e-11_rb, &
+      1.51131e-11_rb,1.66129e-11_rb,1.82416e-11_rb,2.00072e-11_rb,2.19187e-11_rb, &
+      2.39828e-11_rb,2.62171e-11_rb,2.86290e-11_rb,3.12283e-11_rb,3.40276e-11_rb, &
+      3.70433e-11_rb,4.02847e-11_rb,4.37738e-11_rb,4.75070e-11_rb,5.15119e-11_rb, &
+      5.58120e-11_rb,6.04059e-11_rb,6.53208e-11_rb,7.05774e-11_rb,7.61935e-11_rb, &
+      8.21832e-11_rb,8.85570e-11_rb,9.53575e-11_rb,1.02592e-10_rb,1.10298e-10_rb, &
+      1.18470e-10_rb,1.27161e-10_rb,1.36381e-10_rb,1.46161e-10_rb,1.56529e-10_rb, &
+      1.67521e-10_rb,1.79142e-10_rb,1.91423e-10_rb,2.04405e-10_rb,2.18123e-10_rb, &
+      2.32608e-10_rb,2.47889e-10_rb,2.63994e-10_rb,2.80978e-10_rb,2.98843e-10_rb/)
+      totplnkderiv(51:100,13) = (/ &
+      3.17659e-10_rb,3.37423e-10_rb,3.58206e-10_rb,3.80090e-10_rb,4.02996e-10_rb, &
+      4.27065e-10_rb,4.52298e-10_rb,4.78781e-10_rb,5.06493e-10_rb,5.35576e-10_rb, &
+      5.65942e-10_rb,5.97761e-10_rb,6.31007e-10_rb,6.65740e-10_rb,7.02095e-10_rb, &
+      7.39945e-10_rb,7.79575e-10_rb,8.20845e-10_rb,8.63870e-10_rb,9.08680e-10_rb, &
+      9.55385e-10_rb,1.00416e-09_rb,1.05464e-09_rb,1.10737e-09_rb,1.16225e-09_rb, &
+      1.21918e-09_rb,1.27827e-09_rb,1.33988e-09_rb,1.40370e-09_rb,1.46994e-09_rb, &
+      1.53850e-09_rb,1.60993e-09_rb,1.68382e-09_rb,1.76039e-09_rb,1.83997e-09_rb, &
+      1.92182e-09_rb,2.00686e-09_rb,2.09511e-09_rb,2.18620e-09_rb,2.28034e-09_rb, &
+      2.37753e-09_rb,2.47805e-09_rb,2.58193e-09_rb,2.68935e-09_rb,2.80064e-09_rb, &
+      2.91493e-09_rb,3.03271e-09_rb,3.15474e-09_rb,3.27987e-09_rb,3.40936e-09_rb/)
+      totplnkderiv(101:150,13) = (/ &
+      3.54277e-09_rb,3.68019e-09_rb,3.82173e-09_rb,3.96703e-09_rb,4.11746e-09_rb, &
+      4.27104e-09_rb,4.43020e-09_rb,4.59395e-09_rb,4.76060e-09_rb,4.93430e-09_rb, &
+      5.11085e-09_rb,5.29280e-09_rb,5.48055e-09_rb,5.67300e-09_rb,5.86950e-09_rb, &
+      6.07160e-09_rb,6.28015e-09_rb,6.49295e-09_rb,6.71195e-09_rb,6.93455e-09_rb, &
+      7.16470e-09_rb,7.39985e-09_rb,7.64120e-09_rb,7.88885e-09_rb,8.13910e-09_rb, &
+      8.39930e-09_rb,8.66535e-09_rb,8.93600e-09_rb,9.21445e-09_rb,9.49865e-09_rb, &
+      9.78845e-09_rb,1.00856e-08_rb,1.04361e-08_rb,1.07018e-08_rb,1.10164e-08_rb, &
+      1.13438e-08_rb,1.16748e-08_rb,1.20133e-08_rb,1.23575e-08_rb,1.27117e-08_rb, &
+      1.30708e-08_rb,1.34383e-08_rb,1.38138e-08_rb,1.41985e-08_rb,1.45859e-08_rb, &
+      1.49846e-08_rb,1.53879e-08_rb,1.58042e-08_rb,1.62239e-08_rb,1.66529e-08_rb/)
+      totplnkderiv(151:181,13) = (/ &
+      1.70954e-08_rb,1.75422e-08_rb,1.79943e-08_rb,1.84537e-08_rb,1.89280e-08_rb, &
+      1.94078e-08_rb,1.98997e-08_rb,2.03948e-08_rb,2.08956e-08_rb,2.14169e-08_rb, &
+      2.19330e-08_rb,2.24773e-08_rb,2.30085e-08_rb,2.35676e-08_rb,2.41237e-08_rb, &
+      2.46919e-08_rb,2.52720e-08_rb,2.58575e-08_rb,2.64578e-08_rb,2.70675e-08_rb, &
+      2.76878e-08_rb,2.83034e-08_rb,2.89430e-08_rb,2.95980e-08_rb,3.02480e-08_rb, &
+      3.09105e-08_rb,3.15980e-08_rb,3.22865e-08_rb,3.29755e-08_rb,3.36775e-08_rb, &
+      3.43990e-08_rb/)
+      totplnkderiv(1:50,14) = (/ &
+      1.81489e-12_rb,2.03846e-12_rb,2.28659e-12_rb,2.56071e-12_rb,2.86352e-12_rb, &
+      3.19789e-12_rb,3.56668e-12_rb,3.97211e-12_rb,4.41711e-12_rb,4.90616e-12_rb, &
+      5.44153e-12_rb,6.02790e-12_rb,6.67001e-12_rb,7.37018e-12_rb,8.13433e-12_rb, &
+      8.96872e-12_rb,9.87526e-12_rb,1.08601e-11_rb,1.19328e-11_rb,1.30938e-11_rb, &
+      1.43548e-11_rb,1.57182e-11_rb,1.71916e-11_rb,1.87875e-11_rb,2.05091e-11_rb, &
+      2.23652e-11_rb,2.43627e-11_rb,2.65190e-11_rb,2.88354e-11_rb,3.13224e-11_rb, &
+      3.39926e-11_rb,3.68664e-11_rb,3.99372e-11_rb,4.32309e-11_rb,4.67496e-11_rb, &
+      5.05182e-11_rb,5.45350e-11_rb,5.88268e-11_rb,6.34126e-11_rb,6.82878e-11_rb, &
+      7.34973e-11_rb,7.90201e-11_rb,8.49075e-11_rb,9.11725e-11_rb,9.78235e-11_rb, &
+      1.04856e-10_rb,1.12342e-10_rb,1.20278e-10_rb,1.28680e-10_rb,1.37560e-10_rb/)
+      totplnkderiv(51:100,14) = (/ &
+      1.46953e-10_rb,1.56900e-10_rb,1.67401e-10_rb,1.78498e-10_rb,1.90161e-10_rb, &
+      2.02523e-10_rb,2.15535e-10_rb,2.29239e-10_rb,2.43665e-10_rb,2.58799e-10_rb, &
+      2.74767e-10_rb,2.91522e-10_rb,3.09141e-10_rb,3.27625e-10_rb,3.47011e-10_rb, &
+      3.67419e-10_rb,3.88720e-10_rb,4.11066e-10_rb,4.34522e-10_rb,4.59002e-10_rb, &
+      4.84657e-10_rb,5.11391e-10_rb,5.39524e-10_rb,5.68709e-10_rb,5.99240e-10_rb, &
+      6.31295e-10_rb,6.64520e-10_rb,6.99200e-10_rb,7.35525e-10_rb,7.73135e-10_rb, &
+      8.12440e-10_rb,8.53275e-10_rb,8.95930e-10_rb,9.40165e-10_rb,9.86260e-10_rb, &
+      1.03423e-09_rb,1.08385e-09_rb,1.13567e-09_rb,1.18916e-09_rb,1.24469e-09_rb, &
+      1.30262e-09_rb,1.36268e-09_rb,1.42479e-09_rb,1.48904e-09_rb,1.55557e-09_rb, &
+      1.62478e-09_rb,1.69642e-09_rb,1.77023e-09_rb,1.84696e-09_rb,1.92646e-09_rb/)
+      totplnkderiv(101:150,14) = (/ &
+      2.00831e-09_rb,2.09299e-09_rb,2.18007e-09_rb,2.27093e-09_rb,2.36398e-09_rb, &
+      2.46020e-09_rb,2.55985e-09_rb,2.66230e-09_rb,2.76795e-09_rb,2.87667e-09_rb, &
+      2.98971e-09_rb,3.10539e-09_rb,3.22462e-09_rb,3.34779e-09_rb,3.47403e-09_rb, &
+      3.60419e-09_rb,3.73905e-09_rb,3.87658e-09_rb,4.01844e-09_rb,4.16535e-09_rb, &
+      4.31470e-09_rb,4.46880e-09_rb,4.62765e-09_rb,4.78970e-09_rb,4.95735e-09_rb, &
+      5.12890e-09_rb,5.30430e-09_rb,5.48595e-09_rb,5.67010e-09_rb,5.86145e-09_rb, &
+      6.05740e-09_rb,6.25725e-09_rb,6.46205e-09_rb,6.67130e-09_rb,6.88885e-09_rb, &
+      7.10845e-09_rb,7.33450e-09_rb,7.56700e-09_rb,7.80440e-09_rb,8.04465e-09_rb, &
+      8.29340e-09_rb,8.54820e-09_rb,8.80790e-09_rb,9.07195e-09_rb,9.34605e-09_rb, &
+      9.62005e-09_rb,9.90685e-09_rb,1.01939e-08_rb,1.04938e-08_rb,1.07957e-08_rb/)
+      totplnkderiv(151:181,14) = (/ &
+      1.11059e-08_rb,1.14208e-08_rb,1.17447e-08_rb,1.20717e-08_rb,1.24088e-08_rb, &
+      1.27490e-08_rb,1.31020e-08_rb,1.34601e-08_rb,1.38231e-08_rb,1.41966e-08_rb, &
+      1.45767e-08_rb,1.49570e-08_rb,1.53503e-08_rb,1.57496e-08_rb,1.61663e-08_rb, &
+      1.65784e-08_rb,1.70027e-08_rb,1.74290e-08_rb,1.78730e-08_rb,1.83235e-08_rb, &
+      1.87810e-08_rb,1.92418e-08_rb,1.97121e-08_rb,2.01899e-08_rb,2.05787e-08_rb, &
+      2.11784e-08_rb,2.16824e-08_rb,2.21931e-08_rb,2.27235e-08_rb,2.32526e-08_rb, &
+      2.37850e-08_rb/)
+      totplnkderiv(1:50,15) = (/ &
+      5.39905e-13_rb,6.11835e-13_rb,6.92224e-13_rb,7.81886e-13_rb,8.81851e-13_rb, &
+      9.93072e-13_rb,1.11659e-12_rb,1.25364e-12_rb,1.40562e-12_rb,1.57359e-12_rb, &
+      1.75937e-12_rb,1.96449e-12_rb,2.19026e-12_rb,2.43892e-12_rb,2.71249e-12_rb, &
+      3.01233e-12_rb,3.34163e-12_rb,3.70251e-12_rb,4.09728e-12_rb,4.52885e-12_rb, &
+      4.99939e-12_rb,5.51242e-12_rb,6.07256e-12_rb,6.68167e-12_rb,7.34274e-12_rb, &
+      8.06178e-12_rb,8.84185e-12_rb,9.68684e-12_rb,1.06020e-11_rb,1.15909e-11_rb, &
+      1.26610e-11_rb,1.38158e-11_rb,1.50620e-11_rb,1.64047e-11_rb,1.78508e-11_rb, &
+      1.94055e-11_rb,2.10805e-11_rb,2.28753e-11_rb,2.48000e-11_rb,2.68699e-11_rb, &
+      2.90824e-11_rb,3.14526e-11_rb,3.39882e-11_rb,3.67020e-11_rb,3.95914e-11_rb, &
+      4.26870e-11_rb,4.59824e-11_rb,4.94926e-11_rb,5.32302e-11_rb,5.72117e-11_rb/)
+      totplnkderiv(51:100,15) = (/ &
+      6.14475e-11_rb,6.59483e-11_rb,7.07393e-11_rb,7.57999e-11_rb,8.11980e-11_rb, &
+      8.68920e-11_rb,9.29390e-11_rb,9.93335e-11_rb,1.06101e-10_rb,1.13263e-10_rb, &
+      1.20827e-10_rb,1.28819e-10_rb,1.37255e-10_rb,1.46163e-10_rb,1.55547e-10_rb, &
+      1.65428e-10_rb,1.75837e-10_rb,1.86816e-10_rb,1.98337e-10_rb,2.10476e-10_rb, &
+      2.23218e-10_rb,2.36600e-10_rb,2.50651e-10_rb,2.65425e-10_rb,2.80895e-10_rb, &
+      2.97102e-10_rb,3.14100e-10_rb,3.31919e-10_rb,3.50568e-10_rb,3.70064e-10_rb, &
+      3.90464e-10_rb,4.11813e-10_rb,4.34111e-10_rb,4.57421e-10_rb,4.81717e-10_rb, &
+      5.07039e-10_rb,5.33569e-10_rb,5.61137e-10_rb,5.89975e-10_rb,6.19980e-10_rb, &
+      6.51170e-10_rb,6.83650e-10_rb,7.17520e-10_rb,7.52735e-10_rb,7.89390e-10_rb, &
+      8.27355e-10_rb,8.66945e-10_rb,9.08020e-10_rb,9.50665e-10_rb,9.95055e-10_rb/)
+      totplnkderiv(101:150,15) = (/ &
+      1.04101e-09_rb,1.08864e-09_rb,1.13823e-09_rb,1.18923e-09_rb,1.24257e-09_rb, &
+      1.29741e-09_rb,1.35442e-09_rb,1.41347e-09_rb,1.47447e-09_rb,1.53767e-09_rb, &
+      1.60322e-09_rb,1.67063e-09_rb,1.74033e-09_rb,1.81256e-09_rb,1.88704e-09_rb, &
+      1.96404e-09_rb,2.04329e-09_rb,2.12531e-09_rb,2.21032e-09_rb,2.29757e-09_rb, &
+      2.38739e-09_rb,2.48075e-09_rb,2.57628e-09_rb,2.67481e-09_rb,2.77627e-09_rb, &
+      2.88100e-09_rb,2.98862e-09_rb,3.09946e-09_rb,3.21390e-09_rb,3.33105e-09_rb, &
+      3.45185e-09_rb,3.57599e-09_rb,3.70370e-09_rb,3.83512e-09_rb,3.96909e-09_rb, &
+      4.10872e-09_rb,4.25070e-09_rb,4.39605e-09_rb,4.54670e-09_rb,4.70015e-09_rb, &
+      4.85850e-09_rb,5.02050e-09_rb,5.18655e-09_rb,5.35815e-09_rb,5.53180e-09_rb, &
+      5.71225e-09_rb,5.89495e-09_rb,6.08260e-09_rb,6.27485e-09_rb,6.47345e-09_rb/)
+      totplnkderiv(151:181,15) = (/ &
+      6.67520e-09_rb,6.88310e-09_rb,7.09400e-09_rb,7.31140e-09_rb,7.53350e-09_rb, &
+      7.76040e-09_rb,7.99215e-09_rb,8.22850e-09_rb,8.47235e-09_rb,8.71975e-09_rb, &
+      8.97360e-09_rb,9.23365e-09_rb,9.49950e-09_rb,9.76965e-09_rb,1.00441e-08_rb, &
+      1.03270e-08_rb,1.06158e-08_rb,1.09112e-08_rb,1.12111e-08_rb,1.15172e-08_rb, &
+      1.18263e-08_rb,1.21475e-08_rb,1.24735e-08_rb,1.28027e-08_rb,1.32023e-08_rb, &
+      1.34877e-08_rb,1.38399e-08_rb,1.42000e-08_rb,1.45625e-08_rb,1.49339e-08_rb, &
+      1.53156e-08_rb/)
+      totplnkderiv(1:50,16) = (/ &
+      4.38799e-14_rb,5.04835e-14_rb,5.79773e-14_rb,6.64627e-14_rb,7.60706e-14_rb, &
+      8.69213e-14_rb,9.91554e-14_rb,1.12932e-13_rb,1.28419e-13_rb,1.45809e-13_rb, &
+      1.65298e-13_rb,1.87109e-13_rb,2.11503e-13_rb,2.38724e-13_rb,2.69058e-13_rb, &
+      3.02878e-13_rb,3.40423e-13_rb,3.82128e-13_rb,4.28390e-13_rb,4.79625e-13_rb, &
+      5.36292e-13_rb,5.98933e-13_rb,6.68066e-13_rb,7.44216e-13_rb,8.28159e-13_rb, &
+      9.20431e-13_rb,1.02180e-12_rb,1.13307e-12_rb,1.25504e-12_rb,1.38863e-12_rb, &
+      1.53481e-12_rb,1.69447e-12_rb,1.86896e-12_rb,2.05903e-12_rb,2.26637e-12_rb, &
+      2.49193e-12_rb,2.73736e-12_rb,3.00416e-12_rb,3.29393e-12_rb,3.60781e-12_rb, &
+      3.94805e-12_rb,4.31675e-12_rb,4.71543e-12_rb,5.14627e-12_rb,5.61226e-12_rb, &
+      6.11456e-12_rb,6.65585e-12_rb,7.23969e-12_rb,7.86811e-12_rb,8.54456e-12_rb/)
+      totplnkderiv(51:100,16) = (/ &
+      9.27075e-12_rb,1.00516e-11_rb,1.08898e-11_rb,1.17884e-11_rb,1.27514e-11_rb, &
+      1.37839e-11_rb,1.48893e-11_rb,1.60716e-11_rb,1.73333e-11_rb,1.86849e-11_rb, &
+      2.01237e-11_rb,2.16610e-11_rb,2.33001e-11_rb,2.50440e-11_rb,2.69035e-11_rb, &
+      2.88827e-11_rb,3.09881e-11_rb,3.32234e-11_rb,3.55981e-11_rb,3.81193e-11_rb, &
+      4.07946e-11_rb,4.36376e-11_rb,4.66485e-11_rb,4.98318e-11_rb,5.32080e-11_rb, &
+      5.67754e-11_rb,6.05524e-11_rb,6.45450e-11_rb,6.87639e-11_rb,7.32160e-11_rb, &
+      7.79170e-11_rb,8.28780e-11_rb,8.81045e-11_rb,9.36200e-11_rb,9.94280e-11_rb, &
+      1.05545e-10_rb,1.11982e-10_rb,1.18752e-10_rb,1.25866e-10_rb,1.33350e-10_rb, &
+      1.41210e-10_rb,1.49469e-10_rb,1.58143e-10_rb,1.67233e-10_rb,1.76760e-10_rb, &
+      1.86758e-10_rb,1.97236e-10_rb,2.08227e-10_rb,2.19723e-10_rb,2.31737e-10_rb/)
+      totplnkderiv(101:150,16) = (/ &
+      2.44329e-10_rb,2.57503e-10_rb,2.71267e-10_rb,2.85647e-10_rb,3.00706e-10_rb, &
+      3.16391e-10_rb,3.32807e-10_rb,3.49887e-10_rb,3.67748e-10_rb,3.86369e-10_rb, &
+      4.05746e-10_rb,4.25984e-10_rb,4.47060e-10_rb,4.68993e-10_rb,4.91860e-10_rb, &
+      5.15601e-10_rb,5.40365e-10_rb,5.66085e-10_rb,5.92855e-10_rb,6.20640e-10_rb, &
+      6.49605e-10_rb,6.79585e-10_rb,7.10710e-10_rb,7.43145e-10_rb,7.76805e-10_rb, &
+      8.11625e-10_rb,8.47800e-10_rb,8.85300e-10_rb,9.24220e-10_rb,9.64550e-10_rb, &
+      1.00623e-09_rb,1.04957e-09_rb,1.09429e-09_rb,1.14079e-09_rb,1.18882e-09_rb, &
+      1.23848e-09_rb,1.28986e-09_rb,1.34301e-09_rb,1.39796e-09_rb,1.45493e-09_rb, &
+      1.51372e-09_rb,1.57440e-09_rb,1.63702e-09_rb,1.70173e-09_rb,1.76874e-09_rb, &
+      1.83753e-09_rb,1.90898e-09_rb,1.98250e-09_rb,2.05836e-09_rb,2.13646e-09_rb/)
+      totplnkderiv(151:181,16) = (/ &
+      2.21710e-09_rb,2.30027e-09_rb,2.38591e-09_rb,2.47432e-09_rb,2.56503e-09_rb, &
+      2.65878e-09_rb,2.75516e-09_rb,2.85432e-09_rb,2.95688e-09_rb,3.06201e-09_rb, &
+      3.17023e-09_rb,3.28153e-09_rb,3.39604e-09_rb,3.51391e-09_rb,3.63517e-09_rb, &
+      3.75955e-09_rb,3.88756e-09_rb,4.01880e-09_rb,4.15405e-09_rb,4.29255e-09_rb, &
+      4.43535e-09_rb,4.58145e-09_rb,4.73165e-09_rb,4.88560e-09_rb,5.04390e-09_rb, &
+      5.20630e-09_rb,5.37255e-09_rb,5.54355e-09_rb,5.71915e-09_rb,5.89855e-09_rb, &
+      6.08280e-09_rb/)
+      totplk16deriv(1:50) = (/ &
+      4.35811e-14_rb,5.01270e-14_rb,5.75531e-14_rb,6.59588e-14_rb,7.54735e-14_rb, &
+      8.62147e-14_rb,9.83225e-14_rb,1.11951e-13_rb,1.27266e-13_rb,1.44456e-13_rb, &
+      1.63715e-13_rb,1.85257e-13_rb,2.09343e-13_rb,2.36209e-13_rb,2.66136e-13_rb, &
+      2.99486e-13_rb,3.36493e-13_rb,3.77582e-13_rb,4.23146e-13_rb,4.73578e-13_rb, &
+      5.29332e-13_rb,5.90936e-13_rb,6.58891e-13_rb,7.33710e-13_rb,8.16135e-13_rb, &
+      9.06705e-13_rb,1.00614e-12_rb,1.11524e-12_rb,1.23477e-12_rb,1.36561e-12_rb, &
+      1.50871e-12_rb,1.66488e-12_rb,1.83552e-12_rb,2.02123e-12_rb,2.22375e-12_rb, &
+      2.44389e-12_rb,2.68329e-12_rb,2.94338e-12_rb,3.22570e-12_rb,3.53129e-12_rb, &
+      3.86236e-12_rb,4.22086e-12_rb,4.60827e-12_rb,5.02666e-12_rb,5.47890e-12_rb, &
+      5.96595e-12_rb,6.49057e-12_rb,7.05592e-12_rb,7.66401e-12_rb,8.31821e-12_rb/)
+      totplk16deriv(51:100) = (/ &
+      9.01998e-12_rb,9.77390e-12_rb,1.05826e-11_rb,1.14491e-11_rb,1.23769e-11_rb, &
+      1.33709e-11_rb,1.44341e-11_rb,1.55706e-11_rb,1.67821e-11_rb,1.80793e-11_rb, &
+      1.94586e-11_rb,2.09316e-11_rb,2.25007e-11_rb,2.41685e-11_rb,2.59454e-11_rb, &
+      2.78356e-11_rb,2.98440e-11_rb,3.19744e-11_rb,3.42355e-11_rb,3.66340e-11_rb, &
+      3.91772e-11_rb,4.18773e-11_rb,4.47339e-11_rb,4.77509e-11_rb,5.09490e-11_rb, &
+      5.43240e-11_rb,5.78943e-11_rb,6.16648e-11_rb,6.56445e-11_rb,6.98412e-11_rb, &
+      7.42680e-11_rb,7.89335e-11_rb,8.38450e-11_rb,8.90220e-11_rb,9.44695e-11_rb, &
+      1.00197e-10_rb,1.06221e-10_rb,1.12550e-10_rb,1.19193e-10_rb,1.26175e-10_rb, &
+      1.33498e-10_rb,1.41188e-10_rb,1.49251e-10_rb,1.57693e-10_rb,1.66530e-10_rb, &
+      1.75798e-10_rb,1.85495e-10_rb,1.95661e-10_rb,2.06275e-10_rb,2.17357e-10_rb/)
+      totplk16deriv(101:150) = (/ &
+      2.28959e-10_rb,2.41085e-10_rb,2.53739e-10_rb,2.66944e-10_rb,2.80755e-10_rb, &
+      2.95121e-10_rb,3.10141e-10_rb,3.25748e-10_rb,3.42057e-10_rb,3.59026e-10_rb, &
+      3.76668e-10_rb,3.95066e-10_rb,4.14211e-10_rb,4.34111e-10_rb,4.54818e-10_rb, &
+      4.76295e-10_rb,4.98681e-10_rb,5.21884e-10_rb,5.46000e-10_rb,5.71015e-10_rb, &
+      5.97065e-10_rb,6.23965e-10_rb,6.51865e-10_rb,6.80905e-10_rb,7.11005e-10_rb, &
+      7.42100e-10_rb,7.74350e-10_rb,8.07745e-10_rb,8.42355e-10_rb,8.78185e-10_rb, &
+      9.15130e-10_rb,9.53520e-10_rb,9.93075e-10_rb,1.03415e-09_rb,1.07649e-09_rb, &
+      1.12021e-09_rb,1.16539e-09_rb,1.21207e-09_rb,1.26025e-09_rb,1.31014e-09_rb, &
+      1.36156e-09_rb,1.41453e-09_rb,1.46909e-09_rb,1.52540e-09_rb,1.58368e-09_rb, &
+      1.64334e-09_rb,1.70527e-09_rb,1.76888e-09_rb,1.83442e-09_rb,1.90182e-09_rb/)
+      totplk16deriv(151:181) = (/ &
+      1.97128e-09_rb,2.04281e-09_rb,2.11635e-09_rb,2.19219e-09_rb,2.26979e-09_rb, &
+      2.34989e-09_rb,2.43219e-09_rb,2.51660e-09_rb,2.60396e-09_rb,2.69317e-09_rb, &
+      2.78501e-09_rb,2.87927e-09_rb,2.97600e-09_rb,3.07548e-09_rb,3.17772e-09_rb, &
+      3.28235e-09_rb,3.38982e-09_rb,3.49985e-09_rb,3.61307e-09_rb,3.72883e-09_rb, &
+      3.84805e-09_rb,3.96975e-09_rb,4.09465e-09_rb,4.22240e-09_rb,4.35370e-09_rb, &
+      4.48800e-09_rb,4.62535e-09_rb,4.76640e-09_rb,4.91110e-09_rb,5.05850e-09_rb, &
+      5.20965e-09_rb/)
+
+      end subroutine lwavplankderiv
+
+      end module rrtmg_lw_setcoef
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_lw_taumol.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_lw_taumol.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_lw_taumol.f90	(revision 1585)
@@ -0,0 +1,3150 @@
+!     path:      $Source: /storm/rc1/cvsroot/rc/rrtmg_lw/src/rrtmg_lw_taumol.f90,v $
+!     author:    $Author: miacono $
+!     revision:  $Revision: 1.8 $
+!     created:   $Date: 2011/04/08 20:25:01 $
+!
+      module rrtmg_lw_taumol
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb 
+      use parrrtm, only : mg, nbndlw, maxxsec, ngptlw
+      use rrlw_con, only: oneminus
+      use rrlw_wvn, only: nspa, nspb
+      use rrlw_vsn, only: hvrtau, hnamtau
+
+      implicit none
+
+      contains
+
+!----------------------------------------------------------------------------
+      subroutine taumol(nlayers, pavel, wx, coldry, &
+                        laytrop, jp, jt, jt1, planklay, planklev, plankbnd, &
+                        colh2o, colco2, colo3, coln2o, colco, colch4, colo2, &
+                        colbrd, fac00, fac01, fac10, fac11, &
+                        rat_h2oco2, rat_h2oco2_1, rat_h2oo3, rat_h2oo3_1, &
+                        rat_h2on2o, rat_h2on2o_1, rat_h2och4, rat_h2och4_1, &
+                        rat_n2oco2, rat_n2oco2_1, rat_o3co2, rat_o3co2_1, &
+                        selffac, selffrac, indself, forfac, forfrac, indfor, &
+                        minorfrac, scaleminor, scaleminorn2, indminor, &
+                        fracs, taug)
+!----------------------------------------------------------------------------
+
+! *******************************************************************************
+! *                                                                             *
+! *                  Optical depths developed for the                           *
+! *                                                                             *
+! *                RAPID RADIATIVE TRANSFER MODEL (RRTM)                        *
+! *                                                                             *
+! *                                                                             *
+! *            ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     *
+! *                        131 HARTWELL AVENUE                                  *
+! *                        LEXINGTON, MA 02421                                  *
+! *                                                                             *
+! *                                                                             *
+! *                           ELI J. MLAWER                                     * 
+! *                         JENNIFER DELAMERE                                   * 
+! *                         STEVEN J. TAUBMAN                                   *
+! *                         SHEPARD A. CLOUGH                                   *
+! *                                                                             *
+! *                                                                             *
+! *                                                                             *
+! *                                                                             *
+! *                       email:  mlawer@aer.com                                *
+! *                       email:  jdelamer@aer.com                              *
+! *                                                                             *
+! *        The authors wish to acknowledge the contributions of the             *
+! *        following people:  Karen Cady-Pereira, Patrick D. Brown,             *  
+! *        Michael J. Iacono, Ronald E. Farren, Luke Chen, Robert Bergstrom.    *
+! *                                                                             *
+! *******************************************************************************
+! *                                                                             *
+! *  Revision for g-point reduction: Michael J. Iacono, AER, Inc.               *
+! *                                                                             *
+! *******************************************************************************
+! *     TAUMOL                                                                  *
+! *                                                                             *
+! *     This file contains the subroutines TAUGBn (where n goes from            *
+! *     1 to 16).  TAUGBn calculates the optical depths and Planck fractions    *
+! *     per g-value and layer for band n.                                       *
+! *                                                                             *
+! *  Output:  optical depths (unitless)                                         *
+! *           fractions needed to compute Planck functions at every layer       *
+! *               and g-value                                                   *
+! *                                                                             *
+! *     COMMON /TAUGCOM/  TAUG(MXLAY,MG)                                        *
+! *     COMMON /PLANKG/   FRACS(MXLAY,MG)                                       *
+! *                                                                             *
+! *  Input                                                                      *
+! *                                                                             *
+! *     COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)                  *
+! *     COMMON /PRECISE/  ONEMINUS                                              *
+! *     COMMON /PROFILE/  NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY),                    *
+! *     &                 PZ(0:MXLAY),TZ(0:MXLAY)                               *
+! *     COMMON /PROFDATA/ LAYTROP,                                              *
+! *    &                  COLH2O(MXLAY),COLCO2(MXLAY),COLO3(MXLAY),             *
+! *    &                  COLN2O(MXLAY),COLCO(MXLAY),COLCH4(MXLAY),             *
+! *    &                  COLO2(MXLAY)
+! *     COMMON /INTFAC/   FAC00(MXLAY),FAC01(MXLAY),                            *
+! *    &                  FAC10(MXLAY),FAC11(MXLAY)                             *
+! *     COMMON /INTIND/   JP(MXLAY),JT(MXLAY),JT1(MXLAY)                        *
+! *     COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY)       *
+! *                                                                             *
+! *     Description:                                                            *
+! *     NG(IBAND) - number of g-values in band IBAND                            *
+! *     NSPA(IBAND) - for the lower atmosphere, the number of reference         *
+! *                   atmospheres that are stored for band IBAND per            *
+! *                   pressure level and temperature.  Each of these            *
+! *                   atmospheres has different relative amounts of the         *
+! *                   key species for the band (i.e. different binary           *
+! *                   species parameters).                                      *
+! *     NSPB(IBAND) - same for upper atmosphere                                 *
+! *     ONEMINUS - since problems are caused in some cases by interpolation     *
+! *                parameters equal to or greater than 1, for these cases       *
+! *                these parameters are set to this value, slightly < 1.        *
+! *     PAVEL - layer pressures (mb)                                            *
+! *     TAVEL - layer temperatures (degrees K)                                  *
+! *     PZ - level pressures (mb)                                               *
+! *     TZ - level temperatures (degrees K)                                     *
+! *     LAYTROP - layer at which switch is made from one combination of         *
+! *               key species to another                                        *
+! *     COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water         *
+! *               vapor,carbon dioxide, ozone, nitrous ozide, methane,          *
+! *               respectively (molecules/cm**2)                                *
+! *     FACij(LAY) - for layer LAY, these are factors that are needed to        *
+! *                  compute the interpolation factors that multiply the        *
+! *                  appropriate reference k-values.  A value of 0 (1) for      *
+! *                  i,j indicates that the corresponding factor multiplies     *
+! *                  reference k-value for the lower (higher) of the two        *
+! *                  appropriate temperatures, and altitudes, respectively.     *
+! *     JP - the index of the lower (in altitude) of the two appropriate        *
+! *          reference pressure levels needed for interpolation                 *
+! *     JT, JT1 - the indices of the lower of the two appropriate reference     *
+! *               temperatures needed for interpolation (for pressure           *
+! *               levels JP and JP+1, respectively)                             *
+! *     SELFFAC - scale factor needed for water vapor self-continuum, equals    *
+! *               (water vapor density)/(atmospheric density at 296K and        *
+! *               1013 mb)                                                      *
+! *     SELFFRAC - factor needed for temperature interpolation of reference     *
+! *                water vapor self-continuum data                              *
+! *     INDSELF - index of the lower of the two appropriate reference           *
+! *               temperatures needed for the self-continuum interpolation      *
+! *     FORFAC  - scale factor needed for water vapor foreign-continuum.        *
+! *     FORFRAC - factor needed for temperature interpolation of reference      *
+! *                water vapor foreign-continuum data                           *
+! *     INDFOR  - index of the lower of the two appropriate reference           *
+! *               temperatures needed for the foreign-continuum interpolation   *
+! *                                                                             *
+! *  Data input                                                                 *
+! *     COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG),*
+! *                 FORREF(4,MG), KA_M'MGAS', KB_M'MGAS'                        *
+! *        (note:  n is the band number,'MGAS' is the species name of the minor *
+! *         gas)                                                                *
+! *                                                                             *
+! *     Description:                                                            *
+! *     KA - k-values for low reference atmospheres (key-species only)          *
+! *          (units: cm**2/molecule)                                            *
+! *     KB - k-values for high reference atmospheres (key-species only)         *
+! *          (units: cm**2/molecule)                                            *
+! *     KA_M'MGAS' - k-values for low reference atmosphere minor species        *
+! *          (units: cm**2/molecule)                                            *
+! *     KB_M'MGAS' - k-values for high reference atmosphere minor species       *
+! *          (units: cm**2/molecule)                                            *
+! *     SELFREF - k-values for water vapor self-continuum for reference         *
+! *               atmospheres (used below LAYTROP)                              *
+! *               (units: cm**2/molecule)                                       *
+! *     FORREF  - k-values for water vapor foreign-continuum for reference      *
+! *               atmospheres (used below/above LAYTROP)                        *
+! *               (units: cm**2/molecule)                                       *
+! *                                                                             *
+! *     DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG)                     *
+! *     EQUIVALENCE (KA,ABSA),(KB,ABSB)                                         *
+! *                                                                             *
+!*******************************************************************************
+
+! ------- Declarations -------
+
+! ----- Input -----
+      integer(kind=im), intent(in) :: nlayers         ! total number of layers
+      real(kind=rb), intent(in) :: pavel(:)           ! layer pressures (mb) 
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: wx(:,:)            ! cross-section amounts (mol/cm2)
+                                                      !    Dimensions: (maxxsec,nlayers)
+      real(kind=rb), intent(in) :: coldry(:)          ! column amount (dry air)
+                                                      !    Dimensions: (nlayers)
+
+      integer(kind=im), intent(in) :: laytrop         ! tropopause layer index
+      integer(kind=im), intent(in) :: jp(:)           ! 
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt(:)           !
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt1(:)          !
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: planklay(:,:)      ! 
+                                                      !    Dimensions: (nlayers,nbndlw)
+      real(kind=rb), intent(in) :: planklev(0:,:)     ! 
+                                                      !    Dimensions: (nlayers,nbndlw)
+      real(kind=rb), intent(in) :: plankbnd(:)        ! 
+                                                      !    Dimensions: (nbndlw)
+
+      real(kind=rb), intent(in) :: colh2o(:)          ! column amount (h2o)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colco2(:)          ! column amount (co2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo3(:)           ! column amount (o3)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: coln2o(:)          ! column amount (n2o)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colco(:)           ! column amount (co)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colch4(:)          ! column amount (ch4)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo2(:)           ! column amount (o2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colbrd(:)          ! column amount (broadening gases)
+                                                      !    Dimensions: (nlayers)
+
+      integer(kind=im), intent(in) :: indself(:)
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: indfor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffrac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: forfac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: forfrac(:)
+                                                      !    Dimensions: (nlayers)
+
+      integer(kind=im), intent(in) :: indminor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: minorfrac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: scaleminor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: scaleminorn2(:)
+                                                      !    Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: &                  !
+                       fac00(:), fac01(:), &          !    Dimensions: (nlayers)
+                       fac10(:), fac11(:) 
+      real(kind=rb), intent(in) :: &                  !
+                       rat_h2oco2(:),rat_h2oco2_1(:), &
+                       rat_h2oo3(:),rat_h2oo3_1(:), & !    Dimensions: (nlayers)
+                       rat_h2on2o(:),rat_h2on2o_1(:), &
+                       rat_h2och4(:),rat_h2och4_1(:), &
+                       rat_n2oco2(:),rat_n2oco2_1(:), &
+                       rat_o3co2(:),rat_o3co2_1(:)
+
+! ----- Output -----
+      real(kind=rb), intent(out) :: fracs(:,:)        ! planck fractions
+                                                      !    Dimensions: (nlayers,ngptlw)
+      real(kind=rb), intent(out) :: taug(:,:)         ! gaseous optical depth 
+                                                      !    Dimensions: (nlayers,ngptlw)
+
+      hvrtau = '$Revision: 1.8 $'
+
+! Calculate gaseous optical depth and planck fractions for each spectral band.
+
+      call taugb1
+      call taugb2
+      call taugb3
+      call taugb4
+      call taugb5
+      call taugb6
+      call taugb7
+      call taugb8
+      call taugb9
+      call taugb10
+      call taugb11
+      call taugb12
+      call taugb13
+      call taugb14
+      call taugb15
+      call taugb16
+
+      contains
+
+!----------------------------------------------------------------------------
+      subroutine taugb1
+!----------------------------------------------------------------------------
+
+! ------- Modifications -------
+!  Written by Eli J. Mlawer, Atmospheric & Environmental Research.
+!  Revised by Michael J. Iacono, Atmospheric & Environmental Research.
+!
+!     band 1:  10-350 cm-1 (low key - h2o; low minor - n2)
+!                          (high key - h2o; high minor - n2)
+!
+!     note: previous versions of rrtm band 1: 
+!           10-250 cm-1 (low - h2o; high - h2o)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng1
+      use rrlw_kg01, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mn2, kb_mn2, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      real(kind=rb) :: pp, corradj, scalen2, tauself, taufor, taun2
+
+
+! Minor gas mapping levels:
+!     lower - n2, p = 142.5490 mbar, t = 215.70 k
+!     upper - n2, p = 142.5490 mbar, t = 215.70 k
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature.  Below laytrop, the water vapor self-continuum and
+! foreign continuum is interpolated (in temperature) separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(1) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(1) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+         pp = pavel(lay)
+         corradj =  1.
+         if (pp .lt. 250._rb) then
+            corradj = 1._rb - 0.15_rb * (250._rb-pp) / 154.4_rb
+         endif
+
+         scalen2 = colbrd(lay) * scaleminorn2(lay)
+         do ig = 1, ng1
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) -  forref(indf,ig))) 
+            taun2 = scalen2*(ka_mn2(indm,ig) + & 
+                 minorfrac(lay) * (ka_mn2(indm+1,ig) - ka_mn2(indm,ig)))
+            taug(lay,ig) = corradj * (colh2o(lay) * &
+                (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) & 
+                 + tauself + taufor + taun2)
+             fracs(lay,ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(1) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(1) + 1
+         indf = indfor(lay)
+         indm = indminor(lay)
+         pp = pavel(lay)
+         corradj =  1._rb - 0.15_rb * (pp / 95.6_rb)
+
+         scalen2 = colbrd(lay) * scaleminorn2(lay)
+         do ig = 1, ng1
+            taufor = forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * (forref(indf+1,ig) - forref(indf,ig))) 
+            taun2 = scalen2*(kb_mn2(indm,ig) + & 
+                 minorfrac(lay) * (kb_mn2(indm+1,ig) - kb_mn2(indm,ig)))
+            taug(lay,ig) = corradj * (colh2o(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) &  
+                 + taufor + taun2)
+            fracs(lay,ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb1
+
+!----------------------------------------------------------------------------
+      subroutine taugb2
+!----------------------------------------------------------------------------
+!
+!     band 2:  350-500 cm-1 (low key - h2o; high key - h2o)
+!
+!     note: previous version of rrtm band 2: 
+!           250 - 500 cm-1 (low - h2o; high - h2o)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng2, ngs1
+      use rrlw_kg02, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, ig
+      real(kind=rb) :: pp, corradj, tauself, taufor
+
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature.  Below laytrop, the water vapor self-continuum and
+! foreign continuum is interpolated (in temperature) separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(2) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(2) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         pp = pavel(lay)
+         corradj = 1._rb - .05_rb * (pp - 100._rb) / 900._rb
+         do ig = 1, ng2
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            taug(lay,ngs1+ig) = corradj * (colh2o(lay) * &
+                (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) &
+                 + tauself + taufor)
+            fracs(lay,ngs1+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(2) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(2) + 1
+         indf = indfor(lay)
+         do ig = 1, ng2
+            taufor =  forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * (forref(indf+1,ig) - forref(indf,ig))) 
+            taug(lay,ngs1+ig) = colh2o(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) &
+                 + taufor
+            fracs(lay,ngs1+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb2
+
+!----------------------------------------------------------------------------
+      subroutine taugb3
+!----------------------------------------------------------------------------
+!
+!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
+!                           (high key - h2o,co2; high minor - n2o)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng3, ngs2
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg03, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mn2o, kb_mn2o, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      integer(kind=im) :: js, js1, jmn2o, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_mn2o, specparm_mn2o, specmult_mn2o, &
+                       fmn2o, fmn2omf, chi_n2o, ratn2o, adjfac, adjcoln2o
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor, n2om1, n2om2, absn2o
+      real(kind=rb) :: refrat_planck_a, refrat_planck_b, refrat_m_a, refrat_m_b
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Minor gas mapping levels:
+!     lower - n2o, p = 706.272 mbar, t = 278.94 k
+!     upper - n2o, p = 95.58 mbar, t = 215.7 k
+
+!  P = 212.725 mb
+      refrat_planck_a = chi_mls(1,9)/chi_mls(2,9)
+
+!  P = 95.58 mb
+      refrat_planck_b = chi_mls(1,13)/chi_mls(2,13)
+
+!  P = 706.270mb
+      refrat_m_a = chi_mls(1,3)/chi_mls(2,3)
+
+!  P = 95.58 mb 
+      refrat_m_b = chi_mls(1,13)/chi_mls(2,13)
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature, and appropriate species.  Below laytrop, the water vapor 
+! self-continuum and foreign continuum is interpolated (in temperature) 
+! separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2oco2(lay)*colco2(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)        
+
+         speccomb1 = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_mn2o = colh2o(lay) + refrat_m_a*colco2(lay)
+         specparm_mn2o = colh2o(lay)/speccomb_mn2o
+         if (specparm_mn2o .ge. oneminus) specparm_mn2o = oneminus
+         specmult_mn2o = 8._rb*specparm_mn2o
+         jmn2o = 1 + int(specmult_mn2o)
+         fmn2o = mod(specmult_mn2o,1.0_rb)
+         fmn2omf = minorfrac(lay)*fmn2o
+!  In atmospheres where the amount of N2O is too great to be considered
+!  a minor species, adjust the column amount of N2O by an empirical factor 
+!  to obtain the proper contribution.
+         chi_n2o = coln2o(lay)/coldry(lay)
+         ratn2o = 1.e20_rb*chi_n2o/chi_mls(4,jp(lay)+1)
+         if (ratn2o .gt. 1.5_rb) then
+            adjfac = 0.5_rb+(ratn2o-0.5_rb)**0.65_rb
+            adjcoln2o = adjfac*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcoln2o = coln2o(lay)
+         endif
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colco2(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(3) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(3) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng3
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            n2om1 = ka_mn2o(jmn2o,indm,ig) + fmn2o * &
+                 (ka_mn2o(jmn2o+1,indm,ig) - ka_mn2o(jmn2o,indm,ig))
+            n2om2 = ka_mn2o(jmn2o,indm+1,ig) + fmn2o * &
+                 (ka_mn2o(jmn2o+1,indm+1,ig) - ka_mn2o(jmn2o,indm+1,ig))
+            absn2o = n2om1 + minorfrac(lay) * (n2om2 - n2om1)
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) +  &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs2+ig) = tau_major + tau_major1 &
+                 + tauself + taufor &
+                 + adjcoln2o*absn2o
+            fracs(lay,ngs2+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+         speccomb = colh2o(lay) + rat_h2oco2(lay)*colco2(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 4._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 4._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs1) * fac01(lay)
+         fac011 = (1._rb - fs1) * fac11(lay)
+         fac101 = fs1 * fac01(lay)
+         fac111 = fs1 * fac11(lay)
+
+         speccomb_mn2o = colh2o(lay) + refrat_m_b*colco2(lay)
+         specparm_mn2o = colh2o(lay)/speccomb_mn2o
+         if (specparm_mn2o .ge. oneminus) specparm_mn2o = oneminus
+         specmult_mn2o = 4._rb*specparm_mn2o
+         jmn2o = 1 + int(specmult_mn2o)
+         fmn2o = mod(specmult_mn2o,1.0_rb)
+         fmn2omf = minorfrac(lay)*fmn2o
+!  In atmospheres where the amount of N2O is too great to be considered
+!  a minor species, adjust the column amount of N2O by an empirical factor 
+!  to obtain the proper contribution.
+         chi_n2o = coln2o(lay)/coldry(lay)
+         ratn2o = 1.e20*chi_n2o/chi_mls(4,jp(lay)+1)
+         if (ratn2o .gt. 1.5_rb) then
+            adjfac = 0.5_rb+(ratn2o-0.5_rb)**0.65_rb
+            adjcoln2o = adjfac*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcoln2o = coln2o(lay)
+         endif
+
+         speccomb_planck = colh2o(lay)+refrat_planck_b*colco2(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 4._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(3) + js
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(3) + js1
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         do ig = 1, ng3
+            taufor = forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * (forref(indf+1,ig) - forref(indf,ig))) 
+            n2om1 = kb_mn2o(jmn2o,indm,ig) + fmn2o * &
+                 (kb_mn2o(jmn2o+1,indm,ig)-kb_mn2o(jmn2o,indm,ig))
+            n2om2 = kb_mn2o(jmn2o,indm+1,ig) + fmn2o * &
+                 (kb_mn2o(jmn2o+1,indm+1,ig)-kb_mn2o(jmn2o,indm+1,ig))
+            absn2o = n2om1 + minorfrac(lay) * (n2om2 - n2om1)
+            taug(lay,ngs2+ig) = speccomb * &
+                (fac000 * absb(ind0,ig) + &
+                fac100 * absb(ind0+1,ig) + &
+                fac010 * absb(ind0+5,ig) + &
+                fac110 * absb(ind0+6,ig)) &
+                + speccomb1 * &
+                (fac001 * absb(ind1,ig) +  &
+                fac101 * absb(ind1+1,ig) + &
+                fac011 * absb(ind1+5,ig) + &
+                fac111 * absb(ind1+6,ig))  &
+                + taufor &
+                + adjcoln2o*absn2o
+            fracs(lay,ngs2+ig) = fracrefb(ig,jpl) + fpl * &
+                (fracrefb(ig,jpl+1)-fracrefb(ig,jpl))
+         enddo
+      enddo
+
+      end subroutine taugb3
+
+!----------------------------------------------------------------------------
+      subroutine taugb4
+!----------------------------------------------------------------------------
+!
+!     band 4:  630-700 cm-1 (low key - h2o,co2; high key - o3,co2)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng4, ngs3
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg04, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, ig
+      integer(kind=im) :: js, js1, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor
+      real(kind=rb) :: refrat_planck_a, refrat_planck_b
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! P =   142.5940 mb
+      refrat_planck_a = chi_mls(1,11)/chi_mls(2,11)
+
+! P = 95.58350 mb
+      refrat_planck_b = chi_mls(3,13)/chi_mls(2,13)
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature, and appropriate species.  Below laytrop, the water 
+! vapor self-continuum and foreign continuum is interpolated (in temperature) 
+! separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2oco2(lay)*colco2(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colco2(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(4) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(4) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng4
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) +  &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs3+ig) = tau_major + tau_major1 &
+                 + tauself + taufor
+            fracs(lay,ngs3+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+         speccomb = colo3(lay) + rat_o3co2(lay)*colco2(lay)
+         specparm = colo3(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 4._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colo3(lay) + rat_o3co2_1(lay)*colco2(lay)
+         specparm1 = colo3(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 4._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs1) * fac01(lay)
+         fac011 = (1._rb - fs1) * fac11(lay)
+         fac101 = fs1 * fac01(lay)
+         fac111 = fs1 * fac11(lay)
+
+         speccomb_planck = colo3(lay)+refrat_planck_b*colco2(lay)
+         specparm_planck = colo3(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 4._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(4) + js
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(4) + js1
+
+         do ig = 1, ng4
+            taug(lay,ngs3+ig) =  speccomb * &
+                (fac000 * absb(ind0,ig) + &
+                fac100 * absb(ind0+1,ig) + &
+                fac010 * absb(ind0+5,ig) + &
+                fac110 * absb(ind0+6,ig)) &
+                + speccomb1 * &
+                (fac001 * absb(ind1,ig) +  &
+                fac101 * absb(ind1+1,ig) + &
+                fac011 * absb(ind1+5,ig) + &
+                fac111 * absb(ind1+6,ig))
+            fracs(lay,ngs3+ig) = fracrefb(ig,jpl) + fpl * &
+                (fracrefb(ig,jpl+1)-fracrefb(ig,jpl))
+         enddo
+
+! Empirical modification to code to improve stratospheric cooling rates
+! for co2.  Revised to apply weighting for g-point reduction in this band.
+
+         taug(lay,ngs3+8)=taug(lay,ngs3+8)*0.92
+         taug(lay,ngs3+9)=taug(lay,ngs3+9)*0.88
+         taug(lay,ngs3+10)=taug(lay,ngs3+10)*1.07
+         taug(lay,ngs3+11)=taug(lay,ngs3+11)*1.1
+         taug(lay,ngs3+12)=taug(lay,ngs3+12)*0.99
+         taug(lay,ngs3+13)=taug(lay,ngs3+13)*0.88
+         taug(lay,ngs3+14)=taug(lay,ngs3+14)*0.943
+
+      enddo
+
+      end subroutine taugb4
+
+!----------------------------------------------------------------------------
+      subroutine taugb5
+!----------------------------------------------------------------------------
+!
+!     band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
+!                           (high key - o3,co2)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng5, ngs4
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg05, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mo3, selfref, forref, ccl4
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      integer(kind=im) :: js, js1, jmo3, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_mo3, specparm_mo3, specmult_mo3, fmo3
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor, o3m1, o3m2, abso3
+      real(kind=rb) :: refrat_planck_a, refrat_planck_b, refrat_m_a
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Minor gas mapping level :
+!     lower - o3, p = 317.34 mbar, t = 240.77 k
+!     lower - ccl4
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower/upper atmosphere.
+
+! P = 473.420 mb
+      refrat_planck_a = chi_mls(1,5)/chi_mls(2,5)
+
+! P = 0.2369 mb
+      refrat_planck_b = chi_mls(3,43)/chi_mls(2,43)
+
+! P = 317.3480
+      refrat_m_a = chi_mls(1,7)/chi_mls(2,7)
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature, and appropriate species.  Below laytrop, the 
+! water vapor self-continuum and foreign continuum is 
+! interpolated (in temperature) separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2oco2(lay)*colco2(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_mo3 = colh2o(lay) + refrat_m_a*colco2(lay)
+         specparm_mo3 = colh2o(lay)/speccomb_mo3
+         if (specparm_mo3 .ge. oneminus) specparm_mo3 = oneminus
+         specmult_mo3 = 8._rb*specparm_mo3
+         jmo3 = 1 + int(specmult_mo3)
+         fmo3 = mod(specmult_mo3,1.0_rb)
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colco2(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(5) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(5) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng5
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            o3m1 = ka_mo3(jmo3,indm,ig) + fmo3 * &
+                 (ka_mo3(jmo3+1,indm,ig)-ka_mo3(jmo3,indm,ig))
+            o3m2 = ka_mo3(jmo3,indm+1,ig) + fmo3 * &
+                 (ka_mo3(jmo3+1,indm+1,ig)-ka_mo3(jmo3,indm+1,ig))
+            abso3 = o3m1 + minorfrac(lay)*(o3m2-o3m1)
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * & 
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs4+ig) = tau_major + tau_major1 &
+                 + tauself + taufor &
+                 + abso3*colo3(lay) &
+                 + wx(1,lay) * ccl4(ig)
+            fracs(lay,ngs4+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+         speccomb = colo3(lay) + rat_o3co2(lay)*colco2(lay)
+         specparm = colo3(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 4._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colo3(lay) + rat_o3co2_1(lay)*colco2(lay)
+         specparm1 = colo3(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 4._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs1) * fac01(lay)
+         fac011 = (1._rb - fs1) * fac11(lay)
+         fac101 = fs1 * fac01(lay)
+         fac111 = fs1 * fac11(lay)
+
+         speccomb_planck = colo3(lay)+refrat_planck_b*colco2(lay)
+         specparm_planck = colo3(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 4._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(5) + js
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(5) + js1
+         
+         do ig = 1, ng5
+            taug(lay,ngs4+ig) = speccomb * &
+                (fac000 * absb(ind0,ig) + &
+                fac100 * absb(ind0+1,ig) + &
+                fac010 * absb(ind0+5,ig) + &
+                fac110 * absb(ind0+6,ig)) &
+                + speccomb1 * &
+                (fac001 * absb(ind1,ig) + &
+                fac101 * absb(ind1+1,ig) + &
+                fac011 * absb(ind1+5,ig) + &
+                fac111 * absb(ind1+6,ig))  &
+                + wx(1,lay) * ccl4(ig)
+            fracs(lay,ngs4+ig) = fracrefb(ig,jpl) + fpl * &
+                (fracrefb(ig,jpl+1)-fracrefb(ig,jpl))
+         enddo
+      enddo
+
+      end subroutine taugb5
+
+!----------------------------------------------------------------------------
+      subroutine taugb6
+!----------------------------------------------------------------------------
+!
+!     band 6:  820-980 cm-1 (low key - h2o; low minor - co2)
+!                           (high key - nothing; high minor - cfc11, cfc12)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng6, ngs5
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg06, only : fracrefa, absa, ka, ka_mco2, &
+                            selfref, forref, cfc11adj, cfc12
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      real(kind=rb) :: chi_co2, ratco2, adjfac, adjcolco2
+      real(kind=rb) :: tauself, taufor, absco2
+
+
+! Minor gas mapping level:
+!     lower - co2, p = 706.2720 mb, t = 294.2 k
+!     upper - cfc11, cfc12
+
+! Compute the optical depth by interpolating in ln(pressure) and
+! temperature. The water vapor self-continuum and foreign continuum
+! is interpolated (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+! In atmospheres where the amount of CO2 is too great to be considered
+! a minor species, adjust the column amount of CO2 by an empirical factor 
+! to obtain the proper contribution.
+         chi_co2 = colco2(lay)/(coldry(lay))
+         ratco2 = 1.e20_rb*chi_co2/chi_mls(2,jp(lay)+1)
+         if (ratco2 .gt. 3.0_rb) then
+            adjfac = 2.0_rb+(ratco2-2.0_rb)**0.77_rb
+            adjcolco2 = adjfac*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcolco2 = colco2(lay)
+         endif
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(6) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(6) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         do ig = 1, ng6
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))
+            absco2 =  (ka_mco2(indm,ig) + minorfrac(lay) * &
+                 (ka_mco2(indm+1,ig) - ka_mco2(indm,ig)))
+            taug(lay,ngs5+ig) = colh2o(lay) * &
+                (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) +  &
+                 fac11(lay) * absa(ind1+1,ig))  &
+                 + tauself + taufor &
+                 + adjcolco2 * absco2 &
+                 + wx(2,lay) * cfc11adj(ig) &
+                 + wx(3,lay) * cfc12(ig)
+            fracs(lay,ngs5+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+! Nothing important goes on above laytrop in this band.
+      do lay = laytrop+1, nlayers
+
+         do ig = 1, ng6
+            taug(lay,ngs5+ig) = 0.0_rb &
+                 + wx(2,lay) * cfc11adj(ig) &
+                 + wx(3,lay) * cfc12(ig)
+            fracs(lay,ngs5+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+      end subroutine taugb6
+
+!----------------------------------------------------------------------------
+      subroutine taugb7
+!----------------------------------------------------------------------------
+!
+!     band 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
+!                            (high key - o3; high minor - co2)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng7, ngs6
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg07, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mco2, kb_mco2, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      integer(kind=im) :: js, js1, jmco2, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_mco2, specparm_mco2, specmult_mco2, fmco2
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor, co2m1, co2m2, absco2
+      real(kind=rb) :: chi_co2, ratco2, adjfac, adjcolco2
+      real(kind=rb) :: refrat_planck_a, refrat_m_a
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Minor gas mapping level :
+!     lower - co2, p = 706.2620 mbar, t= 278.94 k
+!     upper - co2, p = 12.9350 mbar, t = 234.01 k
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower atmosphere.
+
+! P = 706.2620 mb
+      refrat_planck_a = chi_mls(1,3)/chi_mls(3,3)
+
+! P = 706.2720 mb
+      refrat_m_a = chi_mls(1,3)/chi_mls(3,3)
+
+! Compute the optical depth by interpolating in ln(pressure), 
+! temperature, and appropriate species.  Below laytrop, the water
+! vapor self-continuum and foreign continuum is interpolated 
+! (in temperature) separately. 
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2oo3(lay)*colo3(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2oo3_1(lay)*colo3(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_mco2 = colh2o(lay) + refrat_m_a*colo3(lay)
+         specparm_mco2 = colh2o(lay)/speccomb_mco2
+         if (specparm_mco2 .ge. oneminus) specparm_mco2 = oneminus
+         specmult_mco2 = 8._rb*specparm_mco2
+
+         jmco2 = 1 + int(specmult_mco2)
+         fmco2 = mod(specmult_mco2,1.0_rb)
+
+!  In atmospheres where the amount of CO2 is too great to be considered
+!  a minor species, adjust the column amount of CO2 by an empirical factor 
+!  to obtain the proper contribution.
+         chi_co2 = colco2(lay)/(coldry(lay))
+         ratco2 = 1.e20*chi_co2/chi_mls(2,jp(lay)+1)
+         if (ratco2 .gt. 3.0_rb) then
+            adjfac = 3.0_rb+(ratco2-3.0_rb)**0.79_rb
+            adjcolco2 = adjfac*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcolco2 = colco2(lay)
+         endif
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colo3(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(7) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(7) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng7
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            co2m1 = ka_mco2(jmco2,indm,ig) + fmco2 * &
+                 (ka_mco2(jmco2+1,indm,ig) - ka_mco2(jmco2,indm,ig))
+            co2m2 = ka_mco2(jmco2,indm+1,ig) + fmco2 * &
+                 (ka_mco2(jmco2+1,indm+1,ig) - ka_mco2(jmco2,indm+1,ig))
+            absco2 = co2m1 + minorfrac(lay) * (co2m2 - co2m1)
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) +  &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs6+ig) = tau_major + tau_major1 &
+                 + tauself + taufor &
+                 + adjcolco2*absco2
+            fracs(lay,ngs6+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+!  In atmospheres where the amount of CO2 is too great to be considered
+!  a minor species, adjust the column amount of CO2 by an empirical factor 
+!  to obtain the proper contribution.
+         chi_co2 = colco2(lay)/(coldry(lay))
+         ratco2 = 1.e20*chi_co2/chi_mls(2,jp(lay)+1)
+         if (ratco2 .gt. 3.0_rb) then
+            adjfac = 2.0_rb+(ratco2-2.0_rb)**0.79_rb
+            adjcolco2 = adjfac*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcolco2 = colco2(lay)
+         endif
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(7) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(7) + 1
+         indm = indminor(lay)
+
+         do ig = 1, ng7
+            absco2 = kb_mco2(indm,ig) + minorfrac(lay) * &
+                 (kb_mco2(indm+1,ig) - kb_mco2(indm,ig))
+            taug(lay,ngs6+ig) = colo3(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) &
+                 + adjcolco2 * absco2
+            fracs(lay,ngs6+ig) = fracrefb(ig)
+         enddo
+
+! Empirical modification to code to improve stratospheric cooling rates
+! for o3.  Revised to apply weighting for g-point reduction in this band.
+
+         taug(lay,ngs6+6)=taug(lay,ngs6+6)*0.92_rb
+         taug(lay,ngs6+7)=taug(lay,ngs6+7)*0.88_rb
+         taug(lay,ngs6+8)=taug(lay,ngs6+8)*1.07_rb
+         taug(lay,ngs6+9)=taug(lay,ngs6+9)*1.1_rb
+         taug(lay,ngs6+10)=taug(lay,ngs6+10)*0.99_rb
+         taug(lay,ngs6+11)=taug(lay,ngs6+11)*0.855_rb
+
+      enddo
+
+      end subroutine taugb7
+
+!----------------------------------------------------------------------------
+      subroutine taugb8
+!----------------------------------------------------------------------------
+!
+!     band 8:  1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
+!                             (high key - o3; high minor - co2, n2o)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng8, ngs7
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg08, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mco2, ka_mn2o, ka_mo3, kb_mco2, kb_mn2o, &
+                            selfref, forref, cfc12, cfc22adj
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      real(kind=rb) :: tauself, taufor, absco2, abso3, absn2o
+      real(kind=rb) :: chi_co2, ratco2, adjfac, adjcolco2
+
+
+! Minor gas mapping level:
+!     lower - co2, p = 1053.63 mb, t = 294.2 k
+!     lower - o3,  p = 317.348 mb, t = 240.77 k
+!     lower - n2o, p = 706.2720 mb, t= 278.94 k
+!     lower - cfc12,cfc11
+!     upper - co2, p = 35.1632 mb, t = 223.28 k
+!     upper - n2o, p = 8.716e-2 mb, t = 226.03 k
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature, and appropriate species.  Below laytrop, the water vapor 
+! self-continuum and foreign continuum is interpolated (in temperature) 
+! separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+!  In atmospheres where the amount of CO2 is too great to be considered
+!  a minor species, adjust the column amount of CO2 by an empirical factor 
+!  to obtain the proper contribution.
+         chi_co2 = colco2(lay)/(coldry(lay))
+         ratco2 = 1.e20_rb*chi_co2/chi_mls(2,jp(lay)+1)
+         if (ratco2 .gt. 3.0_rb) then
+            adjfac = 2.0_rb+(ratco2-2.0_rb)**0.65_rb
+            adjcolco2 = adjfac*chi_mls(2,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcolco2 = colco2(lay)
+         endif
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(8) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(8) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         do ig = 1, ng8
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))
+            absco2 =  (ka_mco2(indm,ig) + minorfrac(lay) * &
+                 (ka_mco2(indm+1,ig) - ka_mco2(indm,ig)))
+            abso3 =  (ka_mo3(indm,ig) + minorfrac(lay) * &
+                 (ka_mo3(indm+1,ig) - ka_mo3(indm,ig)))
+            absn2o =  (ka_mn2o(indm,ig) + minorfrac(lay) * &
+                 (ka_mn2o(indm+1,ig) - ka_mn2o(indm,ig)))
+            taug(lay,ngs7+ig) = colh2o(lay) * &
+                 (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) +  &
+                 fac11(lay) * absa(ind1+1,ig)) &
+                 + tauself + taufor &
+                 + adjcolco2*absco2 &
+                 + colo3(lay) * abso3 &
+                 + coln2o(lay) * absn2o &
+                 + wx(3,lay) * cfc12(ig) &
+                 + wx(4,lay) * cfc22adj(ig)
+            fracs(lay,ngs7+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+!  In atmospheres where the amount of CO2 is too great to be considered
+!  a minor species, adjust the column amount of CO2 by an empirical factor 
+!  to obtain the proper contribution.
+         chi_co2 = colco2(lay)/coldry(lay)
+         ratco2 = 1.e20_rb*chi_co2/chi_mls(2,jp(lay)+1)
+         if (ratco2 .gt. 3.0_rb) then
+            adjfac = 2.0_rb+(ratco2-2.0_rb)**0.65_rb
+            adjcolco2 = adjfac*chi_mls(2,jp(lay)+1) * coldry(lay)*1.e-20_rb
+         else
+            adjcolco2 = colco2(lay)
+         endif
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(8) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(8) + 1
+         indm = indminor(lay)
+
+         do ig = 1, ng8
+            absco2 =  (kb_mco2(indm,ig) + minorfrac(lay) * &
+                 (kb_mco2(indm+1,ig) - kb_mco2(indm,ig)))
+            absn2o =  (kb_mn2o(indm,ig) + minorfrac(lay) * &
+                 (kb_mn2o(indm+1,ig) - kb_mn2o(indm,ig)))
+            taug(lay,ngs7+ig) = colo3(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) &
+                 + adjcolco2*absco2 &
+                 + coln2o(lay)*absn2o & 
+                 + wx(3,lay) * cfc12(ig) &
+                 + wx(4,lay) * cfc22adj(ig)
+            fracs(lay,ngs7+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb8
+
+!----------------------------------------------------------------------------
+      subroutine taugb9
+!----------------------------------------------------------------------------
+!
+!     band 9:  1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o)
+!                             (high key - ch4; high minor - n2o)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng9, ngs8
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg09, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mn2o, kb_mn2o, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      integer(kind=im) :: js, js1, jmn2o, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor, n2om1, n2om2, absn2o
+      real(kind=rb) :: chi_n2o, ratn2o, adjfac, adjcoln2o
+      real(kind=rb) :: refrat_planck_a, refrat_m_a
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Minor gas mapping level :
+!     lower - n2o, p = 706.272 mbar, t = 278.94 k
+!     upper - n2o, p = 95.58 mbar, t = 215.7 k
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower/upper atmosphere.
+
+! P = 212 mb
+      refrat_planck_a = chi_mls(1,9)/chi_mls(6,9)
+
+! P = 706.272 mb 
+      refrat_m_a = chi_mls(1,3)/chi_mls(6,3)
+
+! Compute the optical depth by interpolating in ln(pressure), 
+! temperature, and appropriate species.  Below laytrop, the water
+! vapor self-continuum and foreign continuum is interpolated 
+! (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2och4(lay)*colch4(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2och4_1(lay)*colch4(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_mn2o = colh2o(lay) + refrat_m_a*colch4(lay)
+         specparm_mn2o = colh2o(lay)/speccomb_mn2o
+         if (specparm_mn2o .ge. oneminus) specparm_mn2o = oneminus
+         specmult_mn2o = 8._rb*specparm_mn2o
+         jmn2o = 1 + int(specmult_mn2o)
+         fmn2o = mod(specmult_mn2o,1.0_rb)
+
+!  In atmospheres where the amount of N2O is too great to be considered
+!  a minor species, adjust the column amount of N2O by an empirical factor 
+!  to obtain the proper contribution.
+         chi_n2o = coln2o(lay)/(coldry(lay))
+         ratn2o = 1.e20_rb*chi_n2o/chi_mls(4,jp(lay)+1)
+         if (ratn2o .gt. 1.5_rb) then
+            adjfac = 0.5_rb+(ratn2o-0.5_rb)**0.65_rb
+            adjcoln2o = adjfac*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcoln2o = coln2o(lay)
+         endif
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colch4(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(9) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(9) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng9
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            n2om1 = ka_mn2o(jmn2o,indm,ig) + fmn2o * &
+                 (ka_mn2o(jmn2o+1,indm,ig) - ka_mn2o(jmn2o,indm,ig))
+            n2om2 = ka_mn2o(jmn2o,indm+1,ig) + fmn2o * &
+                 (ka_mn2o(jmn2o+1,indm+1,ig) - ka_mn2o(jmn2o,indm+1,ig))
+            absn2o = n2om1 + minorfrac(lay) * (n2om2 - n2om1)
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + & 
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs8+ig) = tau_major + tau_major1 &
+                 + tauself + taufor &
+                 + adjcoln2o*absn2o
+            fracs(lay,ngs8+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+
+!  In atmospheres where the amount of N2O is too great to be considered
+!  a minor species, adjust the column amount of N2O by an empirical factor 
+!  to obtain the proper contribution.
+         chi_n2o = coln2o(lay)/(coldry(lay))
+         ratn2o = 1.e20_rb*chi_n2o/chi_mls(4,jp(lay)+1)
+         if (ratn2o .gt. 1.5_rb) then
+            adjfac = 0.5_rb+(ratn2o-0.5_rb)**0.65_rb
+            adjcoln2o = adjfac*chi_mls(4,jp(lay)+1)*coldry(lay)*1.e-20_rb
+         else
+            adjcoln2o = coln2o(lay)
+         endif
+
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(9) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(9) + 1
+         indm = indminor(lay)
+
+         do ig = 1, ng9
+            absn2o = kb_mn2o(indm,ig) + minorfrac(lay) * &
+                (kb_mn2o(indm+1,ig) - kb_mn2o(indm,ig))
+            taug(lay,ngs8+ig) = colch4(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) +  &
+                 fac11(lay) * absb(ind1+1,ig)) &
+                 + adjcoln2o*absn2o
+            fracs(lay,ngs8+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb9
+
+!----------------------------------------------------------------------------
+      subroutine taugb10
+!----------------------------------------------------------------------------
+!
+!     band 10:  1390-1480 cm-1 (low key - h2o; high key - h2o)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng10, ngs9
+      use rrlw_kg10, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, ig
+      real(kind=rb) :: tauself, taufor
+
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature.  Below laytrop, the water vapor self-continuum and
+! foreign continuum is interpolated (in temperature) separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(10) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(10) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+
+         do ig = 1, ng10
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            taug(lay,ngs9+ig) = colh2o(lay) * &
+                 (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig))  &
+                 + tauself + taufor
+            fracs(lay,ngs9+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(10) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(10) + 1
+         indf = indfor(lay)
+
+         do ig = 1, ng10
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            taug(lay,ngs9+ig) = colh2o(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) +  &
+                 fac11(lay) * absb(ind1+1,ig)) &
+                 + taufor
+            fracs(lay,ngs9+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb10
+
+!----------------------------------------------------------------------------
+      subroutine taugb11
+!----------------------------------------------------------------------------
+!
+!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
+!                              (high key - h2o; high minor - o2)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng11, ngs10
+      use rrlw_kg11, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            ka_mo2, kb_mo2, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      real(kind=rb) :: scaleo2, tauself, taufor, tauo2
+
+
+! Minor gas mapping level :
+!     lower - o2, p = 706.2720 mbar, t = 278.94 k
+!     upper - o2, p = 4.758820 mbarm t = 250.85 k
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature.  Below laytrop, the water vapor self-continuum and
+! foreign continuum is interpolated (in temperature) separately.
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(11) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(11) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+         scaleo2 = colo2(lay)*scaleminor(lay)
+         do ig = 1, ng11
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))
+            tauo2 =  scaleo2 * (ka_mo2(indm,ig) + minorfrac(lay) * &
+                 (ka_mo2(indm+1,ig) - ka_mo2(indm,ig)))
+            taug(lay,ngs10+ig) = colh2o(lay) * &
+                 (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) &
+                 + tauself + taufor &
+                 + tauo2
+            fracs(lay,ngs10+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(11) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(11) + 1
+         indf = indfor(lay)
+         indm = indminor(lay)
+         scaleo2 = colo2(lay)*scaleminor(lay)
+         do ig = 1, ng11
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            tauo2 =  scaleo2 * (kb_mo2(indm,ig) + minorfrac(lay) * &
+                 (kb_mo2(indm+1,ig) - kb_mo2(indm,ig)))
+            taug(lay,ngs10+ig) = colh2o(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig))  &
+                 + taufor &
+                 + tauo2
+            fracs(lay,ngs10+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb11
+
+!----------------------------------------------------------------------------
+      subroutine taugb12
+!----------------------------------------------------------------------------
+!
+!     band 12:  1800-2080 cm-1 (low - h2o,co2; high - nothing)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng12, ngs11
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg12, only : fracrefa, absa, ka, &
+                            selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, ig
+      integer(kind=im) :: js, js1, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor
+      real(kind=rb) :: refrat_planck_a
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower/upper atmosphere.
+
+! P =   174.164 mb 
+      refrat_planck_a = chi_mls(1,10)/chi_mls(2,10)
+
+! Compute the optical depth by interpolating in ln(pressure), 
+! temperature, and appropriate species.  Below laytrop, the water
+! vapor self-continuum adn foreign continuum is interpolated 
+! (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2oco2(lay)*colco2(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2oco2_1(lay)*colco2(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colco2(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(12) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(12) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng12
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs11+ig) = tau_major + tau_major1 &
+                 + tauself + taufor
+            fracs(lay,ngs11+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         do ig = 1, ng12
+            taug(lay,ngs11+ig) = 0.0_rb
+            fracs(lay,ngs11+ig) = 0.0_rb
+         enddo
+      enddo
+
+      end subroutine taugb12
+
+!----------------------------------------------------------------------------
+      subroutine taugb13
+!----------------------------------------------------------------------------
+!
+!     band 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng13, ngs12
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg13, only : fracrefa, fracrefb, absa, ka, &
+                            ka_mco2, ka_mco, kb_mo3, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      integer(kind=im) :: js, js1, jmco2, jmco, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_mco2, specparm_mco2, specmult_mco2, fmco2
+      real(kind=rb) :: speccomb_mco, specparm_mco, specmult_mco, fmco
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor, co2m1, co2m2, absco2 
+      real(kind=rb) :: com1, com2, absco, abso3
+      real(kind=rb) :: chi_co2, ratco2, adjfac, adjcolco2
+      real(kind=rb) :: refrat_planck_a, refrat_m_a, refrat_m_a3
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Minor gas mapping levels :
+!     lower - co2, p = 1053.63 mb, t = 294.2 k
+!     lower - co, p = 706 mb, t = 278.94 k
+!     upper - o3, p = 95.5835 mb, t = 215.7 k
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower/upper atmosphere.
+
+! P = 473.420 mb (Level 5)
+      refrat_planck_a = chi_mls(1,5)/chi_mls(4,5)
+
+! P = 1053. (Level 1)
+      refrat_m_a = chi_mls(1,1)/chi_mls(4,1)
+
+! P = 706. (Level 3)
+      refrat_m_a3 = chi_mls(1,3)/chi_mls(4,3)
+
+! Compute the optical depth by interpolating in ln(pressure), 
+! temperature, and appropriate species.  Below laytrop, the water
+! vapor self-continuum and foreign continuum is interpolated 
+! (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2on2o(lay)*coln2o(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2on2o_1(lay)*coln2o(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_mco2 = colh2o(lay) + refrat_m_a*coln2o(lay)
+         specparm_mco2 = colh2o(lay)/speccomb_mco2
+         if (specparm_mco2 .ge. oneminus) specparm_mco2 = oneminus
+         specmult_mco2 = 8._rb*specparm_mco2
+         jmco2 = 1 + int(specmult_mco2)
+         fmco2 = mod(specmult_mco2,1.0_rb)
+
+!  In atmospheres where the amount of CO2 is too great to be considered
+!  a minor species, adjust the column amount of CO2 by an empirical factor 
+!  to obtain the proper contribution.
+         chi_co2 = colco2(lay)/(coldry(lay))
+         ratco2 = 1.e20_rb*chi_co2/3.55e-4_rb
+         if (ratco2 .gt. 3.0_rb) then
+            adjfac = 2.0_rb+(ratco2-2.0_rb)**0.68_rb
+            adjcolco2 = adjfac*3.55e-4*coldry(lay)*1.e-20_rb
+         else
+            adjcolco2 = colco2(lay)
+         endif
+
+         speccomb_mco = colh2o(lay) + refrat_m_a3*coln2o(lay)
+         specparm_mco = colh2o(lay)/speccomb_mco
+         if (specparm_mco .ge. oneminus) specparm_mco = oneminus
+         specmult_mco = 8._rb*specparm_mco
+         jmco = 1 + int(specmult_mco)
+         fmco = mod(specmult_mco,1.0_rb)
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*coln2o(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(13) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(13) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng13
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor = forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            co2m1 = ka_mco2(jmco2,indm,ig) + fmco2 * &
+                 (ka_mco2(jmco2+1,indm,ig) - ka_mco2(jmco2,indm,ig))
+            co2m2 = ka_mco2(jmco2,indm+1,ig) + fmco2 * &
+                 (ka_mco2(jmco2+1,indm+1,ig) - ka_mco2(jmco2,indm+1,ig))
+            absco2 = co2m1 + minorfrac(lay) * (co2m2 - co2m1)
+            com1 = ka_mco(jmco,indm,ig) + fmco * &
+                 (ka_mco(jmco+1,indm,ig) - ka_mco(jmco,indm,ig))
+            com2 = ka_mco(jmco,indm+1,ig) + fmco * &
+                 (ka_mco(jmco+1,indm+1,ig) - ka_mco(jmco,indm+1,ig))
+            absco = com1 + minorfrac(lay) * (com2 - com1)
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs12+ig) = tau_major + tau_major1 &
+                 + tauself + taufor &
+                 + adjcolco2*absco2 &
+                 + colco(lay)*absco
+            fracs(lay,ngs12+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         indm = indminor(lay)
+         do ig = 1, ng13
+            abso3 = kb_mo3(indm,ig) + minorfrac(lay) * &
+                 (kb_mo3(indm+1,ig) - kb_mo3(indm,ig))
+            taug(lay,ngs12+ig) = colo3(lay)*abso3
+            fracs(lay,ngs12+ig) =  fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb13
+
+!----------------------------------------------------------------------------
+      subroutine taugb14
+!----------------------------------------------------------------------------
+!
+!     band 14:  2250-2380 cm-1 (low - co2; high - co2)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng14, ngs13
+      use rrlw_kg14, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, ig
+      real(kind=rb) :: tauself, taufor
+
+
+! Compute the optical depth by interpolating in ln(pressure) and 
+! temperature.  Below laytrop, the water vapor self-continuum 
+! and foreign continuum is interpolated (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(14) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(14) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         do ig = 1, ng14
+            tauself = selffac(lay) * (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            taug(lay,ngs13+ig) = colco2(lay) * &
+                 (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) &
+                 + tauself + taufor
+            fracs(lay,ngs13+ig) = fracrefa(ig)
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(14) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(14) + 1
+         do ig = 1, ng14
+            taug(lay,ngs13+ig) = colco2(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig))
+            fracs(lay,ngs13+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb14
+
+!----------------------------------------------------------------------------
+      subroutine taugb15
+!----------------------------------------------------------------------------
+!
+!     band 15:  2380-2600 cm-1 (low - n2o,co2; low minor - n2)
+!                              (high - nothing)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng15, ngs14
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg15, only : fracrefa, absa, ka, &
+                            ka_mn2, selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, indm, ig
+      integer(kind=im) :: js, js1, jmn2, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_mn2, specparm_mn2, specmult_mn2, fmn2
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: scalen2, tauself, taufor, n2m1, n2m2, taun2 
+      real(kind=rb) :: refrat_planck_a, refrat_m_a
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Minor gas mapping level : 
+!     Lower - Nitrogen Continuum, P = 1053., T = 294.
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower atmosphere.
+! P = 1053. mb (Level 1)
+      refrat_planck_a = chi_mls(4,1)/chi_mls(2,1)
+
+! P = 1053.
+      refrat_m_a = chi_mls(4,1)/chi_mls(2,1)
+
+! Compute the optical depth by interpolating in ln(pressure), 
+! temperature, and appropriate species.  Below laytrop, the water
+! vapor self-continuum and foreign continuum is interpolated 
+! (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = coln2o(lay) + rat_n2oco2(lay)*colco2(lay)
+         specparm = coln2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = coln2o(lay) + rat_n2oco2_1(lay)*colco2(lay)
+         specparm1 = coln2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_mn2 = coln2o(lay) + refrat_m_a*colco2(lay)
+         specparm_mn2 = coln2o(lay)/speccomb_mn2
+         if (specparm_mn2 .ge. oneminus) specparm_mn2 = oneminus
+         specmult_mn2 = 8._rb*specparm_mn2
+         jmn2 = 1 + int(specmult_mn2)
+         fmn2 = mod(specmult_mn2,1.0_rb)
+
+         speccomb_planck = coln2o(lay)+refrat_planck_a*colco2(lay)
+         specparm_planck = coln2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(15) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(15) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+         indm = indminor(lay)
+         
+         scalen2 = colbrd(lay)*scaleminor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng15
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+            n2m1 = ka_mn2(jmn2,indm,ig) + fmn2 * &
+                 (ka_mn2(jmn2+1,indm,ig) - ka_mn2(jmn2,indm,ig))
+            n2m2 = ka_mn2(jmn2,indm+1,ig) + fmn2 * &
+                 (ka_mn2(jmn2+1,indm+1,ig) - ka_mn2(jmn2,indm+1,ig))
+            taun2 = scalen2 * (n2m1 + minorfrac(lay) * (n2m2 - n2m1))
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif 
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs14+ig) = tau_major + tau_major1 &
+                 + tauself + taufor &
+                 + taun2
+            fracs(lay,ngs14+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         do ig = 1, ng15
+            taug(lay,ngs14+ig) = 0.0_rb
+            fracs(lay,ngs14+ig) = 0.0_rb
+         enddo
+      enddo
+
+      end subroutine taugb15
+
+!----------------------------------------------------------------------------
+      subroutine taugb16
+!----------------------------------------------------------------------------
+!
+!     band 16:  2600-3250 cm-1 (low key- h2o,ch4; high key - ch4)
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrtm, only : ng16, ngs15
+      use rrlw_ref, only : chi_mls
+      use rrlw_kg16, only : fracrefa, fracrefb, absa, ka, absb, kb, &
+                            selfref, forref
+
+! ------- Declarations -------
+
+! Local 
+      integer(kind=im) :: lay, ind0, ind1, inds, indf, ig
+      integer(kind=im) :: js, js1, jpl
+      real(kind=rb) :: speccomb, specparm, specmult, fs
+      real(kind=rb) :: speccomb1, specparm1, specmult1, fs1
+      real(kind=rb) :: speccomb_planck, specparm_planck, specmult_planck, fpl
+      real(kind=rb) :: p, p4, fk0, fk1, fk2
+      real(kind=rb) :: fac000, fac100, fac200, fac010, fac110, fac210
+      real(kind=rb) :: fac001, fac101, fac201, fac011, fac111, fac211
+      real(kind=rb) :: tauself, taufor
+      real(kind=rb) :: refrat_planck_a
+      real(kind=rb) :: tau_major, tau_major1
+
+
+! Calculate reference ratio to be used in calculation of Planck
+! fraction in lower atmosphere.
+
+! P = 387. mb (Level 6)
+      refrat_planck_a = chi_mls(1,6)/chi_mls(6,6)
+
+! Compute the optical depth by interpolating in ln(pressure), 
+! temperature,and appropriate species.  Below laytrop, the water
+! vapor self-continuum and foreign continuum is interpolated 
+! (in temperature) separately.  
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+
+         speccomb = colh2o(lay) + rat_h2och4(lay)*colch4(lay)
+         specparm = colh2o(lay)/speccomb
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult,1.0_rb)
+
+         speccomb1 = colh2o(lay) + rat_h2och4_1(lay)*colch4(lay)
+         specparm1 = colh2o(lay)/speccomb1
+         if (specparm1 .ge. oneminus) specparm1 = oneminus
+         specmult1 = 8._rb*(specparm1)
+         js1 = 1 + int(specmult1)
+         fs1 = mod(specmult1,1.0_rb)
+
+         speccomb_planck = colh2o(lay)+refrat_planck_a*colch4(lay)
+         specparm_planck = colh2o(lay)/speccomb_planck
+         if (specparm_planck .ge. oneminus) specparm_planck=oneminus
+         specmult_planck = 8._rb*specparm_planck
+         jpl= 1 + int(specmult_planck)
+         fpl = mod(specmult_planck,1.0_rb)
+
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js1
+         inds = indself(lay)
+         indf = indfor(lay)
+
+         if (specparm .lt. 0.125_rb) then
+            p = fs - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else if (specparm .gt. 0.875_rb) then
+            p = -fs 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac000 = fk0*fac00(lay)
+            fac100 = fk1*fac00(lay)
+            fac200 = fk2*fac00(lay)
+            fac010 = fk0*fac10(lay)
+            fac110 = fk1*fac10(lay)
+            fac210 = fk2*fac10(lay)
+         else
+            fac000 = (1._rb - fs) * fac00(lay)
+            fac010 = (1._rb - fs) * fac10(lay)
+            fac100 = fs * fac00(lay)
+            fac110 = fs * fac10(lay)
+         endif
+
+         if (specparm1 .lt. 0.125_rb) then
+            p = fs1 - 1
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else if (specparm1 .gt. 0.875_rb) then
+            p = -fs1 
+            p4 = p**4
+            fk0 = p4
+            fk1 = 1 - p - 2.0_rb*p4
+            fk2 = p + p4
+            fac001 = fk0*fac01(lay)
+            fac101 = fk1*fac01(lay)
+            fac201 = fk2*fac01(lay)
+            fac011 = fk0*fac11(lay)
+            fac111 = fk1*fac11(lay)
+            fac211 = fk2*fac11(lay)
+         else
+            fac001 = (1._rb - fs1) * fac01(lay)
+            fac011 = (1._rb - fs1) * fac11(lay)
+            fac101 = fs1 * fac01(lay)
+            fac111 = fs1 * fac11(lay)
+         endif
+
+         do ig = 1, ng16
+            tauself = selffac(lay)* (selfref(inds,ig) + selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig)))
+            taufor =  forfac(lay) * (forref(indf,ig) + forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+
+            if (specparm .lt. 0.125_rb) then
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac200 * absa(ind0+2,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig) + &
+                    fac210 * absa(ind0+11,ig))
+            else if (specparm .gt. 0.875_rb) then
+               tau_major = speccomb * &
+                    (fac200 * absa(ind0-1,ig) + &
+                    fac100 * absa(ind0,ig) + &
+                    fac000 * absa(ind0+1,ig) + &
+                    fac210 * absa(ind0+8,ig) + &
+                    fac110 * absa(ind0+9,ig) + &
+                    fac010 * absa(ind0+10,ig))
+            else
+               tau_major = speccomb * &
+                    (fac000 * absa(ind0,ig) + &
+                    fac100 * absa(ind0+1,ig) + &
+                    fac010 * absa(ind0+9,ig) + &
+                    fac110 * absa(ind0+10,ig))
+            endif
+
+            if (specparm1 .lt. 0.125_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac201 * absa(ind1+2,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig) + &
+                    fac211 * absa(ind1+11,ig))
+            else if (specparm1 .gt. 0.875_rb) then
+               tau_major1 = speccomb1 * &
+                    (fac201 * absa(ind1-1,ig) + &
+                    fac101 * absa(ind1,ig) + &
+                    fac001 * absa(ind1+1,ig) + &
+                    fac211 * absa(ind1+8,ig) + &
+                    fac111 * absa(ind1+9,ig) + &
+                    fac011 * absa(ind1+10,ig))
+            else
+               tau_major1 = speccomb1 * &
+                    (fac001 * absa(ind1,ig) + &
+                    fac101 * absa(ind1+1,ig) + &
+                    fac011 * absa(ind1+9,ig) + &
+                    fac111 * absa(ind1+10,ig))
+            endif
+
+            taug(lay,ngs15+ig) = tau_major + tau_major1 &
+                 + tauself + taufor
+            fracs(lay,ngs15+ig) = fracrefa(ig,jpl) + fpl * &
+                 (fracrefa(ig,jpl+1)-fracrefa(ig,jpl))
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1
+         do ig = 1, ng16
+            taug(lay,ngs15+ig) = colch4(lay) * &
+                 (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig))
+            fracs(lay,ngs15+ig) = fracrefb(ig)
+         enddo
+      enddo
+
+      end subroutine taugb16
+
+      end subroutine taumol
+
+      end module rrtmg_lw_taumol
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_cldprmc.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_cldprmc.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_cldprmc.f90	(revision 1585)
@@ -0,0 +1,333 @@
+!     path:      $Source$
+!     author:    $Author: miacono $
+!     revision:  $Revision: 23308 $
+!     created:   $Date: 2013-12-27 17:23:51 -0500 (Fri, 27 Dec 2013) $
+
+      module rrtmg_sw_cldprmc
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, only : ngptsw, jpband, jpb1, jpb2
+      use rrsw_cld, only : extliq1, ssaliq1, asyliq1, &
+                           extice2, ssaice2, asyice2, &
+                           extice3, ssaice3, asyice3, fdlice3, &
+                           abari, bbari, cbari, dbari, ebari, fbari
+      use rrsw_wvn, only : wavenum1, wavenum2, ngb
+      use rrsw_vsn, only : hvrclc, hnamclc
+
+      implicit none
+
+      contains
+
+! ----------------------------------------------------------------------------
+      subroutine cldprmc_sw(nlayers, inflag, iceflag, liqflag, cldfmc, &
+                            ciwpmc, clwpmc, reicmc, relqmc, &
+                            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(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: inflag          ! see definitions
+      integer(kind=im), intent(in) :: iceflag         ! see definitions
+      integer(kind=im), intent(in) :: liqflag         ! see definitions
+
+      real(kind=rb), intent(in) :: cldfmc(:,:)        ! cloud fraction [mcica]
+                                                      !    Dimensions: (ngptsw,nlayers)
+      real(kind=rb), intent(in) :: ciwpmc(:,:)        ! cloud ice water path [mcica]
+                                                      !    Dimensions: (ngptsw,nlayers)
+      real(kind=rb), intent(in) :: clwpmc(:,:)        ! cloud liquid water path [mcica]
+                                                      !    Dimensions: (ngptsw,nlayers)
+      real(kind=rb), intent(in) :: relqmc(:)          ! cloud liquid particle effective radius (microns)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), 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(kind=rb), intent(in) :: fsfcmc(:,:)        ! cloud forward scattering fraction
+                                                      !    Dimensions: (ngptsw,nlayers)
+
+! ------- Output -------
+
+      real(kind=rb), intent(inout) :: taucmc(:,:)     ! cloud optical depth (delta scaled)
+                                                      !    Dimensions: (ngptsw,nlayers)
+      real(kind=rb), intent(inout) :: ssacmc(:,:)     ! single scattering albedo (delta scaled)
+                                                      !    Dimensions: (ngptsw,nlayers)
+      real(kind=rb), intent(inout) :: asmcmc(:,:)     ! asymmetry parameter (delta scaled)
+                                                      !    Dimensions: (ngptsw,nlayers)
+      real(kind=rb), intent(out) :: taormc(:,:)       ! cloud optical depth (non-delta scaled)
+                                                      !    Dimensions: (ngptsw,nlayers)
+
+! ------- Local -------
+
+!      integer(kind=im) :: ncbands
+      integer(kind=im) :: ib, lay, istr, index, icx, ig
+
+      real(kind=rb), parameter :: eps = 1.e-06_rb     ! epsilon
+      real(kind=rb), parameter :: cldmin = 1.e-20_rb  ! minimum value for cloud quantities
+      real(kind=rb) :: cwp                            ! total cloud water path
+      real(kind=rb) :: radliq                         ! cloud liquid droplet radius (microns)
+      real(kind=rb) :: radice                         ! cloud ice effective size (microns)
+      real(kind=rb) :: factor
+      real(kind=rb) :: fint
+
+      real(kind=rb) :: taucldorig_a, taucloud_a, ssacloud_a, ffp, ffp1, ffpssa
+      real(kind=rb) :: tauiceorig, scatice, ssaice, tauice, tauliqorig, scatliq, ssaliq, tauliq
+
+      real(kind=rb) :: fdelta(ngptsw)
+      real(kind=rb) :: extcoice(ngptsw), gice(ngptsw)
+      real(kind=rb) :: ssacoice(ngptsw), forwice(ngptsw)
+      real(kind=rb) :: extcoliq(ngptsw), gliq(ngptsw)
+      real(kind=rb) :: ssacoliq(ngptsw), forwliq(ngptsw)
+
+! Initialize
+
+      hvrclc = '$Revision: 23308 $'
+
+! Some of these initializations are done elsewhere
+      do lay = 1, nlayers
+         do ig = 1, ngptsw
+            taormc(ig,lay) = taucmc(ig,lay)
+!            taucmc(ig,lay) = 0.0_rb
+!            ssacmc(ig,lay) = 1.0_rb
+!            asmcmc(ig,lay) = 0.0_rb
+         enddo
+      enddo
+
+! Main layer loop
+      do lay = 1, nlayers
+
+! Main g-point interval loop
+         do ig = 1, ngptsw 
+            cwp = ciwpmc(ig,lay) + clwpmc(ig,lay)
+            if (cldfmc(ig,lay) .ge. cldmin .and. &
+               (cwp .ge. cldmin .or. taucmc(ig,lay) .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(ig,lay)
+                  ffp = fsfcmc(ig,lay)
+                  ffp1 = 1.0_rb - ffp
+                  ffpssa = 1.0_rb - ffp * ssacmc(ig,lay)
+                  ssacloud_a = ffp1 * ssacmc(ig,lay) / ffpssa
+                  taucloud_a = ffpssa * taucldorig_a
+
+                  taormc(ig,lay) = taucldorig_a
+                  ssacmc(ig,lay) = ssacloud_a
+                  taucmc(ig,lay) = taucloud_a
+                  asmcmc(ig,lay) = (asmcmc(ig,lay) - ffp) / (ffp1)
+
+               elseif (inflag .eq. 1) then 
+                  stop 'INFLAG = 1 OPTION NOT AVAILABLE WITH MCICA'
+
+! (inflag=2): Separate treatement of ice clouds and water clouds.
+               elseif (inflag .eq. 2) then       
+                  radice = reicmc(lay)
+
+! Calculation of absorption coefficients due to ice clouds.
+                  if (ciwpmc(ig,lay) .eq. 0.0_rb) then
+                     extcoice(ig) = 0.0_rb
+                     ssacoice(ig) = 0.0_rb
+                     gice(ig)     = 0.0_rb
+                     forwice(ig)  = 0.0_rb
+
+! (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
+                     if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop &
+                        'ICE RADIUS OUT OF BOUNDS'
+                     ib = ngb(ig)
+                     if (wavenum2(ib) .gt. 1.43e04_rb) then
+                        icx = 1
+                     elseif (wavenum2(ib) .gt. 7.7e03_rb) then
+                        icx = 2
+                     elseif (wavenum2(ib) .gt. 5.3e03_rb) then
+                        icx = 3
+                     elseif (wavenum2(ib) .gt. 4.0e03_rb) then
+                        icx = 4
+                     elseif (wavenum2(ib) .ge. 2.5e03_rb) then
+                        icx = 5
+                     endif
+                     extcoice(ig) = (abari(icx) + bbari(icx)/radice)
+                     ssacoice(ig) = 1._rb - cbari(icx) - dbari(icx) * radice
+                     gice(ig) = ebari(icx) + fbari(icx) * radice
+! Check to ensure upper limit of gice is within physical limits for large particles
+                     if (gice(ig).ge.1._rb) gice(ig) = 1._rb - eps
+                     forwice(ig) = gice(ig)*gice(ig)
+! Check to ensure all calculated quantities are within physical limits.
+                     if (extcoice(ig) .lt. 0.0_rb) stop 'ICE EXTINCTION LESS THAN 0.0'
+                     if (ssacoice(ig) .gt. 1.0_rb) stop 'ICE SSA GRTR THAN 1.0'
+                     if (ssacoice(ig) .lt. 0.0_rb) stop 'ICE SSA LESS THAN 0.0'
+                     if (gice(ig) .gt. 1.0_rb) stop 'ICE ASYM GRTR THAN 1.0'
+                     if (gice(ig) .lt. 0.0_rb) stop 'ICE ASYM LESS THAN 0.0'
+
+! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns
+
+                  elseif (iceflag .eq. 2) then
+                     if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop 'ICE RADIUS OUT OF BOUNDS'
+                     factor = (radice - 2._rb)/3._rb
+                     index = int(factor)
+                     if (index .eq. 43) index = 42
+                     fint = factor - real(index,kind=rb)
+                     ib = ngb(ig)
+                     extcoice(ig) = extice2(index,ib) + fint * &
+                                   (extice2(index+1,ib) -  extice2(index,ib))
+                     ssacoice(ig) = ssaice2(index,ib) + fint * &
+                                   (ssaice2(index+1,ib) -  ssaice2(index,ib))
+                     gice(ig) = asyice2(index,ib) + fint * &
+                                   (asyice2(index+1,ib) -  asyice2(index,ib))
+                     forwice(ig) = gice(ig)*gice(ig)
+! Check to ensure all calculated quantities are within physical limits.
+                     if (extcoice(ig) .lt. 0.0_rb) stop 'ICE EXTINCTION LESS THAN 0.0'
+                     if (ssacoice(ig) .gt. 1.0_rb) stop 'ICE SSA GRTR THAN 1.0'
+                     if (ssacoice(ig) .lt. 0.0_rb) stop 'ICE SSA LESS THAN 0.0'
+                     if (gice(ig) .gt. 1.0_rb) stop 'ICE ASYM GRTR THAN 1.0'
+                     if (gice(ig) .lt. 0.0_rb) stop 'ICE ASYM LESS THAN 0.0'
+
+! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns
+
+                  elseif (iceflag .eq. 3) then
+                     if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) stop 'ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS'
+                     factor = (radice - 2._rb)/3._rb
+                     index = int(factor)
+                     if (index .eq. 46) index = 45
+                     fint = factor - real(index,kind=rb)
+                     ib = ngb(ig)
+                     extcoice(ig) = extice3(index,ib) + fint * &
+                                   (extice3(index+1,ib) - extice3(index,ib))
+                     ssacoice(ig) = ssaice3(index,ib) + fint * &
+                                   (ssaice3(index+1,ib) - ssaice3(index,ib))
+                     gice(ig) = asyice3(index,ib) + fint * &
+                               (asyice3(index+1,ib) - asyice3(index,ib))
+                     fdelta(ig) = fdlice3(index,ib) + fint * &
+                                 (fdlice3(index+1,ib) - fdlice3(index,ib))
+                     if (fdelta(ig) .lt. 0.0_rb) stop 'FDELTA LESS THAN 0.0'
+                     if (fdelta(ig) .gt. 1.0_rb) stop 'FDELTA GT THAN 1.0'
+                     forwice(ig) = fdelta(ig) + 0.5_rb / ssacoice(ig)
+! See Fu 1996 p. 2067 
+                     if (forwice(ig) .gt. gice(ig)) forwice(ig) = gice(ig)
+! Check to ensure all calculated quantities are within physical limits.  
+                     if (extcoice(ig) .lt. 0.0_rb) stop 'ICE EXTINCTION LESS THAN 0.0'
+                     if (ssacoice(ig) .gt. 1.0_rb) stop 'ICE SSA GRTR THAN 1.0'
+                     if (ssacoice(ig) .lt. 0.0_rb) stop 'ICE SSA LESS THAN 0.0'
+                     if (gice(ig) .gt. 1.0_rb) stop 'ICE ASYM GRTR THAN 1.0'
+                     if (gice(ig) .lt. 0.0_rb) stop 'ICE ASYM LESS THAN 0.0'
+
+                  endif
+
+! Calculation of absorption coefficients due to water clouds.
+                  if (clwpmc(ig,lay) .eq. 0.0_rb) then
+                     extcoliq(ig) = 0.0_rb
+                     ssacoliq(ig) = 0.0_rb
+                     gliq(ig) = 0.0_rb
+                     forwliq(ig) = 0.0_rb
+
+                  elseif (liqflag .eq. 1) then
+                     radliq = relqmc(lay)
+                     if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) stop &
+                        'LIQUID EFFECTIVE RADIUS OUT OF BOUNDS'
+                     index = int(radliq - 1.5_rb)
+                     if (index .eq. 0) index = 1
+                     if (index .eq. 58) index = 57
+                     fint = radliq - 1.5_rb - real(index,kind=rb)
+                     ib = ngb(ig)
+                     extcoliq(ig) = extliq1(index,ib) + fint * &
+                                   (extliq1(index+1,ib) - extliq1(index,ib))
+                     ssacoliq(ig) = ssaliq1(index,ib) + fint * &
+                                   (ssaliq1(index+1,ib) - ssaliq1(index,ib))
+                     if (fint .lt. 0._rb .and. ssacoliq(ig) .gt. 1._rb) &
+                                    ssacoliq(ig) = ssaliq1(index,ib)
+                     gliq(ig) = asyliq1(index,ib) + fint * &
+                               (asyliq1(index+1,ib) - asyliq1(index,ib))
+                     forwliq(ig) = gliq(ig)*gliq(ig)
+! Check to ensure all calculated quantities are within physical limits.
+                     if (extcoliq(ig) .lt. 0.0_rb) stop 'LIQUID EXTINCTION LESS THAN 0.0'
+                     if (ssacoliq(ig) .gt. 1.0_rb) stop 'LIQUID SSA GRTR THAN 1.0'
+                     if (ssacoliq(ig) .lt. 0.0_rb) stop 'LIQUID SSA LESS THAN 0.0'
+                     if (gliq(ig) .gt. 1.0_rb) stop 'LIQUID ASYM GRTR THAN 1.0'
+                     if (gliq(ig) .lt. 0.0_rb) stop 'LIQUID ASYM LESS THAN 0.0'
+                  endif
+   
+                  tauliqorig = clwpmc(ig,lay) * extcoliq(ig)
+                  tauiceorig = ciwpmc(ig,lay) * extcoice(ig)
+                  taormc(ig,lay) = tauliqorig + tauiceorig
+
+                  ssaliq = ssacoliq(ig) * (1._rb - forwliq(ig)) / &
+                          (1._rb - forwliq(ig) * ssacoliq(ig))
+                  tauliq = (1._rb - forwliq(ig) * ssacoliq(ig)) * tauliqorig
+                  ssaice = ssacoice(ig) * (1._rb - forwice(ig)) / &
+                          (1._rb - forwice(ig) * ssacoice(ig))
+                  tauice = (1._rb - forwice(ig) * ssacoice(ig)) * tauiceorig
+
+                  scatliq = ssaliq * tauliq
+                  scatice = ssaice * tauice
+                  taucmc(ig,lay) = tauliq + tauice
+
+! Ensure non-zero taucmc and scatice
+                  if(taucmc(ig,lay).eq.0.) taucmc(ig,lay) = cldmin
+                  if(scatice.eq.0.) scatice = cldmin
+
+                  ssacmc(ig,lay) = (scatliq + scatice) / taucmc(ig,lay)
+
+                  if (iceflag .eq. 3) 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(ig,lay) = (1.0_rb/(scatliq+scatice))* &
+                        (scatliq*(gliq(ig)**istr - forwliq(ig)) / &
+                        (1.0_rb - forwliq(ig)) + scatice * ((gice(ig)-forwice(ig))/ &
+                        (1.0_rb - forwice(ig)))**istr)
+
+                  else 
+! This code is the standard method for delta-m scaling. 
+! Set asymetry parameter to first moment (istr=1)
+                     istr = 1
+                     asmcmc(ig,lay) = (scatliq *  &
+                        (gliq(ig)**istr - forwliq(ig)) / &
+                        (1.0_rb - forwliq(ig)) + scatice * (gice(ig)**istr - forwice(ig)) / &
+                        (1.0_rb - forwice(ig)))/(scatliq + scatice)
+                  endif 
+
+               endif
+
+            endif
+
+! End g-point interval loop
+         enddo
+
+! End layer loop
+      enddo
+
+      end subroutine cldprmc_sw
+
+      end module rrtmg_sw_cldprmc
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_cldprop.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_cldprop.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_cldprop.f90	(revision 1585)
@@ -0,0 +1,350 @@
+!     path:      $Source$
+!     author:    $Author: miacono $
+!     revision:  $Revision: 23308 $
+!     created:   $Date: 2013-12-27 17:23:51 -0500 (Fri, 27 Dec 2013) $
+
+      module rrtmg_sw_cldprop
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, only : nbndsw, jpband, jpb1, jpb2
+      use rrsw_cld, only : extliq1, ssaliq1, asyliq1, &
+                           extice2, ssaice2, asyice2, &
+                           extice3, ssaice3, asyice3, fdlice3, &
+                           abari, bbari, cbari, dbari, ebari, fbari
+      use rrsw_wvn, only : wavenum1, wavenum2
+      use rrsw_vsn, only : hvrcld, hnamcld
+
+      implicit none
+
+      contains
+
+! ----------------------------------------------------------------------------
+      subroutine cldprop_sw(nlayers, inflag, iceflag, liqflag, cldfrac, &
+                            tauc, ssac, asmc, fsfc, ciwp, clwp, rei, rel, &
+                            taucldorig, taucloud, ssacloud, asmcloud)
+! ----------------------------------------------------------------------------
+
+! Purpose: Compute the cloud optical properties for each cloudy layer.
+! 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(kind=im), intent(in) :: nlayers         ! total number of layers
+      integer(kind=im), intent(in) :: inflag          ! see definitions
+      integer(kind=im), intent(in) :: iceflag         ! see definitions
+      integer(kind=im), intent(in) :: liqflag         ! see definitions
+
+      real(kind=rb), intent(in) :: cldfrac(:)         ! cloud fraction
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: ciwp(:)            ! cloud ice water path
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: clwp(:)            ! cloud liquid water path
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: rei(:)             ! cloud ice particle effective size (microns)
+                                                      !    Dimensions: (nlayers)
+                                                      ! specific definition of rei 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(kind=rb), intent(in) :: rel(:)             ! cloud liquid particle effective radius (microns)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tauc(:,:)          ! cloud optical depth
+                                                      !    Dimensions: (nbndsw,nlayers)
+      real(kind=rb), intent(in) :: ssac(:,:)          ! single scattering albedo
+                                                      !    Dimensions: (nbndsw,nlayers)
+      real(kind=rb), intent(in) :: asmc(:,:)          ! asymmetry parameter
+                                                      !    Dimensions: (nbndsw,nlayers)
+      real(kind=rb), intent(in) :: fsfc(:,:)          ! forward scattering fraction
+                                                      !    Dimensions: (nbndsw,nlayers)
+
+! ------- Output -------
+
+      real(kind=rb), intent(out) :: taucloud(:,:)     ! cloud optical depth (delta scaled)
+                                                      !    Dimensions: (nlayers,jpband)
+      real(kind=rb), intent(out) :: taucldorig(:,:)   ! cloud optical depth (non-delta scaled)
+                                                      !    Dimensions: (nlayers,jpband)
+      real(kind=rb), intent(out) :: ssacloud(:,:)     ! single scattering albedo (delta scaled)
+                                                      !    Dimensions: (nlayers,jpband)
+      real(kind=rb), intent(out) :: asmcloud(:,:)     ! asymmetry parameter (delta scaled)
+                                                      !    Dimensions: (nlayers,jpband)
+
+! ------- Local -------
+
+!      integer(kind=im) :: ncbands
+      integer(kind=im) :: ib, ib1, ib2, lay, istr, index, icx
+
+      real(kind=rb), parameter :: eps = 1.e-06_rb     ! epsilon
+      real(kind=rb), parameter :: cldmin = 1.e-20_rb  ! minimum value for cloud quantities
+      real(kind=rb) :: cwp                            ! total cloud water path
+      real(kind=rb) :: radliq                         ! cloud liquid droplet radius (microns)
+      real(kind=rb) :: radice                         ! cloud ice effective size (microns)
+      real(kind=rb) :: factor
+      real(kind=rb) :: fint
+      real(kind=rb) :: tauctot(nlayers)               ! band integrated cloud optical depth
+
+      real(kind=rb) :: taucldorig_a, ssacloud_a, taucloud_a, ffp, ffp1, ffpssa
+      real(kind=rb) :: tauiceorig, scatice, ssaice, tauice, tauliqorig, scatliq, ssaliq, tauliq
+
+      real(kind=rb) :: fdelta(jpb1:jpb2)
+      real(kind=rb) :: extcoice(jpb1:jpb2), gice(jpb1:jpb2)
+      real(kind=rb) :: ssacoice(jpb1:jpb2), forwice(jpb1:jpb2)
+      real(kind=rb) :: extcoliq(jpb1:jpb2), gliq(jpb1:jpb2)
+      real(kind=rb) :: ssacoliq(jpb1:jpb2), forwliq(jpb1:jpb2)
+
+! Initialize
+
+      hvrcld = '$Revision: 23308 $'
+
+!      ncbands = 29
+      ib1 = jpb1
+      ib2 = jpb2
+      tauctot(:) = 0._rb
+
+      do lay = 1, nlayers
+         do ib = ib1 , ib2
+            taucldorig(lay,ib) = tauc(ib-15,lay)
+            taucloud(lay,ib) = 0.0_rb
+            ssacloud(lay,ib) = 1.0_rb
+            asmcloud(lay,ib) = 0.0_rb
+            tauctot(lay) = tauctot(lay) + tauc(ib-15,lay)
+         enddo
+      enddo
+
+! Main layer loop
+      do lay = 1, nlayers
+
+         cwp = ciwp(lay) + clwp(lay)
+         if (cldfrac(lay) .ge. cldmin .and. &
+            (cwp .ge. cldmin .or. tauctot(lay) .ge. cldmin)) then
+
+! (inflag=0): Cloud optical properties input directly
+! Cloud optical properties already defined in tauc, ssac, asmc are unscaled;
+! Apply delta-M scaling here
+            if (inflag .eq. 0) then
+
+               do ib = ib1 , ib2
+                  taucldorig_a = tauc(ib-15,lay)
+                  ffp = fsfc(ib-15,lay)
+                  ffp1 = 1.0_rb - ffp
+                  ffpssa = 1.0_rb - ffp * ssac(ib-15,lay)
+                  ssacloud_a = ffp1 * ssac(ib-15,lay) / ffpssa
+                  taucloud_a = ffpssa * taucldorig_a
+
+                  taucldorig(lay,ib) = taucldorig_a
+                  ssacloud(lay,ib) = ssacloud_a
+                  taucloud(lay,ib) = taucloud_a
+                  asmcloud(lay,ib) = (asmc(ib-15,lay) - ffp) / (ffp1)
+               enddo
+
+! (inflag=2): Separate treatement of ice clouds and water clouds.
+            elseif (inflag .eq. 2) then       
+               radice = rei(lay)
+
+! Calculation of absorption coefficients due to ice clouds.
+               if (ciwp(lay) .eq. 0.0_rb) then
+                  do ib = ib1 , ib2
+                     extcoice(ib) = 0.0_rb
+                     ssacoice(ib) = 0.0_rb
+                     gice(ib)     = 0.0_rb
+                     forwice(ib)  = 0.0_rb
+                  enddo
+
+! (iceflag = 1): 
+! Note: This option uses Ebert and Curry approach for all particle sizes similar to
+! CAM3 implementation, though this is somewhat ineffective for large ice particles
+               elseif (iceflag .eq. 1) then
+                  if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop &
+                     'ICE RADIUS OUT OF BOUNDS'
+                  do ib = ib1, ib2
+                     if (wavenum2(ib) .gt. 1.43e04_rb) then
+                        icx = 1
+                     elseif (wavenum2(ib) .gt. 7.7e03_rb) then
+                        icx = 2
+                     elseif (wavenum2(ib) .gt. 5.3e03_rb) then
+                        icx = 3
+                     elseif (wavenum2(ib) .gt. 4.0e03_rb) then
+                        icx = 4
+                     elseif (wavenum2(ib) .ge. 2.5e03_rb) then
+                        icx = 5
+                     endif
+                     extcoice(ib) = abari(icx) + bbari(icx)/radice
+                     ssacoice(ib) = 1._rb - cbari(icx) - dbari(icx) * radice
+                     gice(ib) = ebari(icx) + fbari(icx) * radice
+
+! Check to ensure upper limit of gice is within physical limits for large particles
+                     if (gice(ib) .ge. 1.0_rb) gice(ib) = 1.0_rb - eps
+                     forwice(ib) = gice(ib)*gice(ib)
+! Check to ensure all calculated quantities are within physical limits.
+                     if (extcoice(ib) .lt. 0.0_rb) stop 'ICE EXTINCTION LESS THAN 0.0'
+                     if (ssacoice(ib) .gt. 1.0_rb) stop 'ICE SSA GRTR THAN 1.0'
+                     if (ssacoice(ib) .lt. 0.0_rb) stop 'ICE SSA LESS THAN 0.0'
+                     if (gice(ib) .gt. 1.0_rb) stop 'ICE ASYM GRTR THAN 1.0'
+                     if (gice(ib) .lt. 0.0_rb) stop 'ICE ASYM LESS THAN 0.0'
+                  enddo
+
+! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns
+
+               elseif (iceflag .eq. 2) then
+                  if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop 'ICE RADIUS OUT OF BOUNDS'
+                  factor = (radice - 2._rb)/3._rb
+                  index = int(factor)
+                  if (index .eq. 43) index = 42
+                  fint = factor - real(index,kind=rb)
+                  do ib = ib1, ib2
+                     extcoice(ib) = extice2(index,ib) + fint * &
+                                   (extice2(index+1,ib) -  extice2(index,ib))
+                     ssacoice(ib) = ssaice2(index,ib) + fint * &
+                                   (ssaice2(index+1,ib) -  ssaice2(index,ib))
+                     gice(ib) = asyice2(index,ib) + fint * &
+                                   (asyice2(index+1,ib) -  asyice2(index,ib))
+                     forwice(ib) = gice(ib)*gice(ib)
+! Check to ensure all calculated quantities are within physical limits.
+                     if (extcoice(ib) .lt. 0.0_rb) stop 'ICE EXTINCTION LESS THAN 0.0'
+                     if (ssacoice(ib) .gt. 1.0_rb) stop 'ICE SSA GRTR THAN 1.0'
+                     if (ssacoice(ib) .lt. 0.0_rb) stop 'ICE SSA LESS THAN 0.0'
+                     if (gice(ib) .gt. 1.0_rb) stop 'ICE ASYM GRTR THAN 1.0'
+                     if (gice(ib) .lt. 0.0_rb) stop 'ICE ASYM LESS THAN 0.0'
+                  enddo
+
+! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns
+
+               elseif (iceflag .eq. 3) then
+                  if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) stop 'ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS'
+                  factor = (radice - 2._rb)/3._rb
+                  index = int(factor)
+                  if (index .eq. 46) index = 45
+                  fint = factor - real(index,kind=rb)
+                  do ib = ib1 , ib2
+                     extcoice(ib) = extice3(index,ib) + fint * &
+                                   (extice3(index+1,ib) - extice3(index,ib))
+                     ssacoice(ib) = ssaice3(index,ib) + fint * &
+                                   (ssaice3(index+1,ib) - ssaice3(index,ib))
+                     gice(ib) = asyice3(index,ib) + fint * &
+                               (asyice3(index+1,ib) - asyice3(index,ib))
+                     fdelta(ib) = fdlice3(index,ib) + fint * &
+                                 (fdlice3(index+1,ib) - fdlice3(index,ib))
+                     if (fdelta(ib) .lt. 0.0_rb) stop 'FDELTA LESS THAN 0.0'
+                     if (fdelta(ib) .gt. 1.0_rb) stop 'FDELTA GT THAN 1.0'                     
+                     forwice(ib) = fdelta(ib) + 0.5_rb / ssacoice(ib)
+! See Fu 1996 p. 2067 
+                     if (forwice(ib) .gt. gice(ib)) forwice(ib) = gice(ib)
+! Check to ensure all calculated quantities are within physical limits.
+                     if (extcoice(ib) .lt. 0.0_rb) stop 'ICE EXTINCTION LESS THAN 0.0'
+                     if (ssacoice(ib) .gt. 1.0_rb) stop 'ICE SSA GRTR THAN 1.0'
+                     if (ssacoice(ib) .lt. 0.0_rb) stop 'ICE SSA LESS THAN 0.0'
+                     if (gice(ib) .gt. 1.0_rb) stop 'ICE ASYM GRTR THAN 1.0'
+                     if (gice(ib) .lt. 0.0_rb) stop 'ICE ASYM LESS THAN 0.0'
+                  enddo
+
+               endif
+                  
+! Calculation of absorption coefficients due to water clouds.
+                if (clwp(lay) .eq. 0.0_rb) then
+                   do ib = ib1 , ib2
+                      extcoliq(ib) = 0.0_rb
+                      ssacoliq(ib) = 0.0_rb
+                      gliq(ib) = 0.0_rb
+                      forwliq(ib) = 0.0_rb
+                   enddo
+
+                elseif (liqflag .eq. 1) then
+                   radliq = rel(lay)
+                   if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) stop &
+                      'LIQUID EFFECTIVE RADIUS OUT OF BOUNDS'
+                   index = int(radliq - 1.5_rb)
+                   if (index .eq. 0) index = 1
+                   if (index .eq. 58) index = 57
+                   fint = radliq - 1.5_rb - real(index,kind=rb)
+                   do ib = ib1 , ib2
+                      extcoliq(ib) = extliq1(index,ib) + fint * &
+                                    (extliq1(index+1,ib) - extliq1(index,ib))
+                      ssacoliq(ib) = ssaliq1(index,ib) + fint * &
+                                    (ssaliq1(index+1,ib) - ssaliq1(index,ib))
+                      if (fint .lt. 0._rb .and. ssacoliq(ib) .gt. 1._rb) &
+                                     ssacoliq(ib) = ssaliq1(index,ib)
+                      gliq(ib) = asyliq1(index,ib) + fint * &
+                                (asyliq1(index+1,ib) - asyliq1(index,ib))
+                      forwliq(ib) = gliq(ib)*gliq(ib)
+! Check to ensure all calculated quantities are within physical limits.
+                      if (extcoliq(ib) .lt. 0.0_rb) stop 'LIQUID EXTINCTION LESS THAN 0.0'
+                      if (ssacoliq(ib) .gt. 1.0_rb) stop 'LIQUID SSA GRTR THAN 1.0'
+                      if (ssacoliq(ib) .lt. 0.0_rb) stop 'LIQUID SSA LESS THAN 0.0'
+                      if (gliq(ib) .gt. 1.0_rb) stop 'LIQUID ASYM GRTR THAN 1.0'
+                      if (gliq(ib) .lt. 0.0_rb) stop 'LIQUID ASYM LESS THAN 0.0'
+                   enddo
+                endif
+
+                do ib = ib1 , ib2
+                   tauliqorig = clwp(lay) * extcoliq(ib)
+                   tauiceorig = ciwp(lay) * extcoice(ib)
+                   taucldorig(lay,ib) = tauliqorig + tauiceorig
+
+                   ssaliq = ssacoliq(ib) * (1.0_rb - forwliq(ib)) / &
+                           (1.0_rb - forwliq(ib) * ssacoliq(ib))
+                   tauliq = (1.0_rb - forwliq(ib) * ssacoliq(ib)) * tauliqorig
+                   ssaice = ssacoice(ib) * (1.0_rb - forwice(ib)) / &
+                           (1.0_rb - forwice(ib) * ssacoice(ib))
+                   tauice = (1.0_rb - forwice(ib) * ssacoice(ib)) * tauiceorig
+
+                   scatliq = ssaliq * tauliq
+                   scatice = ssaice * tauice
+
+                   taucloud(lay,ib) = tauliq + tauice
+
+! Ensure non-zero taucmc and scatice
+                   if (taucloud(lay,ib).eq.0.0_rb) taucloud(lay,ib) = cldmin
+                   if (scatice.eq.0.0_rb) scatice = cldmin
+
+                   ssacloud(lay,ib) = (scatliq + scatice) / taucloud(lay,ib)
+
+                   if (iceflag .eq. 3) 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.
+                      istr = 1
+                      asmcloud(lay,ib) = (1.0_rb/(scatliq+scatice)) * &
+                         (scatliq*(gliq(ib)**istr - forwliq(ib)) / &
+                         (1.0_rb - forwliq(ib)) + scatice * ((gice(ib)-forwice(ib)) / &
+                         (1.0_rb - forwice(ib)))**istr)
+                   else 
+! This code is the standard method for delta-m scaling. 
+                      istr = 1
+                      asmcloud(lay,ib) = (scatliq *  &
+                         (gliq(ib)**istr - forwliq(ib)) / &
+                         (1.0_rb - forwliq(ib)) + scatice * (gice(ib)**istr - forwice(ib)) / &
+                         (1.0_rb - forwice(ib)))/(scatliq + scatice)
+                   endif 
+
+                enddo
+
+            endif
+
+         endif
+
+! End layer loop
+      enddo
+
+      end subroutine cldprop_sw
+
+      end module rrtmg_sw_cldprop
+
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_init.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_init.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_init.f90	(revision 1585)
@@ -0,0 +1,3345 @@
+!     path:      $Source$
+!     author:    $Author: miacono $
+!     revision:  $Revision: 23308 $
+!     created:   $Date: 2013-12-27 17:23:51 -0500 (Fri, 27 Dec 2013) $
+
+      module rrtmg_sw_init
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+      use parkind, only : im => kind_im, rb => kind_rb
+      use rrsw_wvn
+      use rrtmg_sw_setcoef, only: swatmref
+
+      implicit none
+
+      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, only : mg, nbndsw, ngptsw
+      use rrsw_tbl, only: ntbl, tblint, pade, bpade, tau_tbl, exp_tbl
+      use rrsw_vsn, only: hvrini, hnamini
+
+      real(kind=rb), intent(in) :: cpdair     ! Specific heat capacity of dry air
+                                              ! at constant pressure at 273 K
+                                              ! (J kg-1 K-1)
+
+! ------- Local -------
+
+      integer(kind=im) :: ibnd, igc, ig, ind, ipr
+      integer(kind=im) :: igcsm, iprsm
+      integer(kind=im) :: itr
+
+      real(kind=rb) :: wtsum, wtsm(mg)
+      real(kind=rb) :: tfn
+
+      real(kind=rb), parameter :: expeps = 1.e-20_rb   ! 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: 23308 $'
+
+! 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
+      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_rb
+      exp_tbl(ntbl) = expeps
+      bpade = 1.0_rb / pade
+      do itr = 1, ntbl-1
+         tfn = real(itr,kind=rb) / real(ntbl,kind=rb)
+         tau_tbl = bpade * tfn / (1._rb - 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_rb
+            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, only: heatfac, grav, planck, boltz, &
+                          clight, avogad, alosmt, gascon, radcn1, radcn2, &
+                          sbcnst, secdy 
+      use rrsw_vsn
+
+      save 
+ 
+      real(kind=rb), 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._rb, 3250._rb, 4000._rb, 4650._rb, 5150._rb, 6150._rb, 7700._rb, &
+                      8050._rb,12850._rb,16000._rb,22650._rb,29000._rb,38000._rb,  820._rb/)
+      wavenum2(:) = (/3250._rb, 4000._rb, 4650._rb, 5150._rb, 6150._rb, 7700._rb, 8050._rb, &
+                     12850._rb,16000._rb,22650._rb,29000._rb,38000._rb,50000._rb, 2600._rb/)
+      delwave(:) =  (/ 650._rb,  750._rb,  650._rb,  500._rb, 1000._rb, 1550._rb,  350._rb, &
+                      4800._rb, 3150._rb, 6650._rb, 6350._rb, 9000._rb,12000._rb, 1780._rb/)
+
+! 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/)
+
+! Fundamental physical constants from NIST 2002
+
+      grav = 9.8066_rb                        ! Acceleration of gravity
+                                              ! (m s-2)
+      planck = 6.62606876e-27_rb              ! Planck constant
+                                              ! (ergs s; g cm2 s-1)
+      boltz = 1.3806503e-16_rb                ! Boltzmann constant
+                                              ! (ergs K-1; g cm2 s-2 K-1)
+      clight = 2.99792458e+10_rb              ! Speed of light in a vacuum  
+                                              ! (cm s-1)
+      avogad = 6.02214199e+23_rb              ! Avogadro constant
+                                              ! (mol-1)
+      alosmt = 2.6867775e+19_rb               ! Loschmidt constant
+                                              ! (cm-3)
+      gascon = 8.31447200e+07_rb              ! Molar gas constant
+                                              ! (ergs mol-1 K-1)
+      radcn1 = 1.191042772e-12_rb             ! First radiation constant
+                                              ! (W cm2 sr-1)
+      radcn2 = 1.4387752_rb                   ! Second radiation constant
+                                              ! (cm K)
+      sbcnst = 5.670400e-04_rb                ! Stefan-Boltzmann constant
+                                              ! (W cm-2 K-4)
+      secdy = 8.6400e4_rb                     ! 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_rb
+!
+!     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_rb
+!
+!     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_rb)
+
+      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_rb, 0.1491729617_rb, 0.1420961469_rb, &
+                  0.1316886544_rb, 0.1181945205_rb, 0.1019300893_rb, &
+                  0.0832767040_rb, 0.0626720116_rb, 0.0424925000_rb, &
+                  0.0046269894_rb, 0.0038279891_rb, 0.0030260086_rb, &
+                  0.0022199750_rb, 0.0014140010_rb, 0.0005330000_rb, &
+                  0.0000750000_rb /)
+
+      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, only : rsrtaua, rsrpiza, rsrasya
+
+      save
+
+      rsrtaua( 1, :) = (/ &
+        0.10849_rb, 0.66699_rb, 0.65255_rb, 0.11600_rb, 0.06529_rb, 0.04468_rb/)
+      rsrtaua( 2, :) = (/ &
+        0.10849_rb, 0.66699_rb, 0.65255_rb, 0.11600_rb, 0.06529_rb, 0.04468_rb/)
+      rsrtaua( 3, :) = (/ &
+        0.20543_rb, 0.84642_rb, 0.84958_rb, 0.21673_rb, 0.28270_rb, 0.10915_rb/)
+      rsrtaua( 4, :) = (/ &
+        0.20543_rb, 0.84642_rb, 0.84958_rb, 0.21673_rb, 0.28270_rb, 0.10915_rb/)
+      rsrtaua( 5, :) = (/ &
+        0.20543_rb, 0.84642_rb, 0.84958_rb, 0.21673_rb, 0.28270_rb, 0.10915_rb/)
+      rsrtaua( 6, :) = (/ &
+        0.20543_rb, 0.84642_rb, 0.84958_rb, 0.21673_rb, 0.28270_rb, 0.10915_rb/)
+      rsrtaua( 7, :) = (/ &
+        0.20543_rb, 0.84642_rb, 0.84958_rb, 0.21673_rb, 0.28270_rb, 0.10915_rb/)
+      rsrtaua( 8, :) = (/ &
+        0.52838_rb, 0.93285_rb, 0.93449_rb, 0.53078_rb, 0.67148_rb, 0.46608_rb/)
+      rsrtaua( 9, :) = (/ &
+        0.52838_rb, 0.93285_rb, 0.93449_rb, 0.53078_rb, 0.67148_rb, 0.46608_rb/)
+      rsrtaua(10, :) = (/ &
+        1.69446_rb, 1.11855_rb, 1.09212_rb, 1.72145_rb, 1.03858_rb, 1.12044_rb/)
+      rsrtaua(11, :) = (/ &
+        1.69446_rb, 1.11855_rb, 1.09212_rb, 1.72145_rb, 1.03858_rb, 1.12044_rb/)
+      rsrtaua(12, :) = (/ &
+        1.69446_rb, 1.11855_rb, 1.09212_rb, 1.72145_rb, 1.03858_rb, 1.12044_rb/)
+      rsrtaua(13, :) = (/ &
+        1.69446_rb, 1.11855_rb, 1.09212_rb, 1.72145_rb, 1.03858_rb, 1.12044_rb/)
+      rsrtaua(14, :) = (/ &
+        0.10849_rb, 0.66699_rb, 0.65255_rb, 0.11600_rb, 0.06529_rb, 0.04468_rb/)
+ 
+      rsrpiza( 1, :) = (/ &
+        .5230504_rb, .7868518_rb, .8531531_rb, .4048149_rb, .8748231_rb, .2355667_rb/)
+      rsrpiza( 2, :) = (/ &
+        .5230504_rb, .7868518_rb, .8531531_rb, .4048149_rb, .8748231_rb, .2355667_rb/)
+      rsrpiza( 3, :) = (/ &
+        .8287144_rb, .9949396_rb, .9279543_rb, .6765051_rb, .9467578_rb, .9955938_rb/)
+      rsrpiza( 4, :) = (/ &
+        .8287144_rb, .9949396_rb, .9279543_rb, .6765051_rb, .9467578_rb, .9955938_rb/)
+      rsrpiza( 5, :) = (/ &
+        .8287144_rb, .9949396_rb, .9279543_rb, .6765051_rb, .9467578_rb, .9955938_rb/)
+      rsrpiza( 6, :) = (/ &
+        .8287144_rb, .9949396_rb, .9279543_rb, .6765051_rb, .9467578_rb, .9955938_rb/)
+      rsrpiza( 7, :) = (/ &
+        .8287144_rb, .9949396_rb, .9279543_rb, .6765051_rb, .9467578_rb, .9955938_rb/)
+      rsrpiza( 8, :) = (/ &
+        .8970131_rb, .9984940_rb, .9245594_rb, .7768385_rb, .9532763_rb, .9999999_rb/)
+      rsrpiza( 9, :) = (/ &
+        .8970131_rb, .9984940_rb, .9245594_rb, .7768385_rb, .9532763_rb, .9999999_rb/)
+      rsrpiza(10, :) = (/ &
+        .9148907_rb, .9956173_rb, .7504584_rb, .8131335_rb, .9401905_rb, .9999999_rb/)
+      rsrpiza(11, :) = (/ &
+        .9148907_rb, .9956173_rb, .7504584_rb, .8131335_rb, .9401905_rb, .9999999_rb/)
+      rsrpiza(12, :) = (/ &
+        .9148907_rb, .9956173_rb, .7504584_rb, .8131335_rb, .9401905_rb, .9999999_rb/)
+      rsrpiza(13, :) = (/ &
+        .9148907_rb, .9956173_rb, .7504584_rb, .8131335_rb, .9401905_rb, .9999999_rb/)
+      rsrpiza(14, :) = (/ &
+        .5230504_rb, .7868518_rb, .8531531_rb, .4048149_rb, .8748231_rb, .2355667_rb/)
+
+      rsrasya( 1, :) = (/ &
+        0.700610_rb, 0.818871_rb, 0.702399_rb, 0.689886_rb, .4629866_rb, .1907639_rb/)
+      rsrasya( 2, :) = (/ &
+        0.700610_rb, 0.818871_rb, 0.702399_rb, 0.689886_rb, .4629866_rb, .1907639_rb/)
+      rsrasya( 3, :) = (/ &
+        0.636342_rb, 0.802467_rb, 0.691305_rb, 0.627497_rb, .6105750_rb, .4760794_rb/)
+      rsrasya( 4, :) = (/ &
+        0.636342_rb, 0.802467_rb, 0.691305_rb, 0.627497_rb, .6105750_rb, .4760794_rb/)
+      rsrasya( 5, :) = (/ &
+        0.636342_rb, 0.802467_rb, 0.691305_rb, 0.627497_rb, .6105750_rb, .4760794_rb/)
+      rsrasya( 6, :) = (/ &
+        0.636342_rb, 0.802467_rb, 0.691305_rb, 0.627497_rb, .6105750_rb, .4760794_rb/)
+      rsrasya( 7, :) = (/ &
+        0.636342_rb, 0.802467_rb, 0.691305_rb, 0.627497_rb, .6105750_rb, .4760794_rb/)
+      rsrasya( 8, :) = (/ &
+        0.668431_rb, 0.788530_rb, 0.698682_rb, 0.657422_rb, .6735182_rb, .6519706_rb/)
+      rsrasya( 9, :) = (/ &
+        0.668431_rb, 0.788530_rb, 0.698682_rb, 0.657422_rb, .6735182_rb, .6519706_rb/)
+      rsrasya(10, :) = (/ &
+        0.729019_rb, 0.803129_rb, 0.784592_rb, 0.712208_rb, .7008249_rb, .7270548_rb/)
+      rsrasya(11, :) = (/ &
+        0.729019_rb, 0.803129_rb, 0.784592_rb, 0.712208_rb, .7008249_rb, .7270548_rb/)
+      rsrasya(12, :) = (/ &
+        0.729019_rb, 0.803129_rb, 0.784592_rb, 0.712208_rb, .7008249_rb, .7270548_rb/)
+      rsrasya(13, :) = (/ &
+        0.729019_rb, 0.803129_rb, 0.784592_rb, 0.712208_rb, .7008249_rb, .7270548_rb/)
+      rsrasya(14, :) = (/ &
+        0.700610_rb, 0.818871_rb, 0.702399_rb, 0.689886_rb, .4629866_rb, .1907639_rb/)
+
+      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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, absch4o, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref, absch4
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, selfrefo, forrefo, sfluxrefo, raylo, &
+                            absa, ka, selfref, forref, sfluxref, rayl
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            abso3ao, abso3bo, raylao, raylbo, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref, &
+                            abso3a, abso3b, rayla, raylb
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, sfluxrefo, &
+                            abso3ao, abso3bo, raylo, &
+                            absa, ka, sfluxref, &
+                            abso3a, abso3b, rayl
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : sfluxrefo, raylo, &
+                            sfluxref, rayl
+
+! ------- Local -------
+      integer(kind=im) :: igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, sfluxrefo, raylo, &
+                            absa, ka, absb, kb, sfluxref, rayl
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, sfluxrefo, &
+                            absa, ka, absb, kb, sfluxref
+
+! ------- Local -------
+      integer(kind=im) :: jn, jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, only : kao, kbo, selfrefo, forrefo, sfluxrefo, &
+                            absh2oo, absco2o, &
+                            absa, ka, absb, kb, selfref, forref, sfluxref, &
+                            absh2o, absco2
+
+! ------- Local -------
+      integer(kind=im) :: jt, jp, igc, ipr, iprsm
+      real(kind=rb) :: 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, 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.
+!
+!     ------------------------------------------------------------------
+
+! Everything below is for INFLAG = 2.
+
+! Coefficients for Ebert and Curry method
+      abari(:) = (/ &
+        & 3.448e-03_rb,3.448e-03_rb,3.448e-03_rb,3.448e-03_rb,3.448e-03_rb /)
+      bbari(:) = (/ &
+        & 2.431e+00_rb,2.431e+00_rb,2.431e+00_rb,2.431e+00_rb,2.431e+00_rb /)
+      cbari(:) = (/ &
+        & 1.000e-05_rb,1.100e-04_rb,1.240e-02_rb,3.779e-02_rb,4.666e-01_rb /)
+      dbari(:) = (/ &
+        & 0.000e+00_rb,1.405e-05_rb,6.867e-04_rb,1.284e-03_rb,2.050e-05_rb /)
+      ebari(:) = (/ &
+        & 7.661e-01_rb,7.730e-01_rb,7.865e-01_rb,8.172e-01_rb,9.595e-01_rb /)
+      fbari(:) = (/ &
+        & 5.851e-04_rb,5.665e-04_rb,7.204e-04_rb,7.463e-04_rb,1.076e-04_rb /)
+
+! LIQFLAG==1 extinction coefficients, single scattering albedos, and asymmetry parameters
+!   Derived from on Mie scattering computations; based on Hu & Stamnes coefficients
+!     BAND  16
+      extliq1(:, 16) = (/ &
+        & 9.004493E-01_rb,6.366723E-01_rb,4.542354E-01_rb,3.468253E-01_rb,2.816431E-01_rb,&
+        & 2.383415E-01_rb,2.070854E-01_rb,1.831854E-01_rb,1.642115E-01_rb,1.487539E-01_rb,&
+        & 1.359169E-01_rb,1.250900E-01_rb,1.158354E-01_rb,1.078400E-01_rb,1.008646E-01_rb,&
+        & 9.472307E-02_rb,8.928000E-02_rb,8.442308E-02_rb,8.005924E-02_rb,7.612231E-02_rb,&
+        & 7.255153E-02_rb,6.929539E-02_rb,6.631769E-02_rb,6.358153E-02_rb,6.106231E-02_rb,&
+        & 5.873077E-02_rb,5.656924E-02_rb,5.455769E-02_rb,5.267846E-02_rb,5.091923E-02_rb,&
+        & 4.926692E-02_rb,4.771154E-02_rb,4.623923E-02_rb,4.484385E-02_rb,4.351539E-02_rb,&
+        & 4.224615E-02_rb,4.103385E-02_rb,3.986538E-02_rb,3.874077E-02_rb,3.765462E-02_rb,&
+        & 3.660077E-02_rb,3.557384E-02_rb,3.457615E-02_rb,3.360308E-02_rb,3.265000E-02_rb,&
+        & 3.171770E-02_rb,3.080538E-02_rb,2.990846E-02_rb,2.903000E-02_rb,2.816461E-02_rb,&
+        & 2.731539E-02_rb,2.648231E-02_rb,2.566308E-02_rb,2.485923E-02_rb,2.407000E-02_rb,&
+        & 2.329615E-02_rb,2.253769E-02_rb,2.179615E-02_rb /)
+!     BAND  17
+      extliq1(:, 17) = (/ &
+       & 6.741200e-01_rb,5.390739e-01_rb,4.198767e-01_rb,3.332553e-01_rb,2.735633e-01_rb,&
+       & 2.317727e-01_rb,2.012760e-01_rb,1.780400e-01_rb,1.596927e-01_rb,1.447980e-01_rb,&
+       & 1.324480e-01_rb,1.220347e-01_rb,1.131327e-01_rb,1.054313e-01_rb,9.870534e-02_rb,&
+       & 9.278200e-02_rb,8.752599e-02_rb,8.282933e-02_rb,7.860600e-02_rb,7.479133e-02_rb,&
+       & 7.132800e-02_rb,6.816733e-02_rb,6.527401e-02_rb,6.261266e-02_rb,6.015934e-02_rb,&
+       & 5.788867e-02_rb,5.578134e-02_rb,5.381667e-02_rb,5.198133e-02_rb,5.026067e-02_rb,&
+       & 4.864466e-02_rb,4.712267e-02_rb,4.568066e-02_rb,4.431200e-02_rb,4.300867e-02_rb,&
+       & 4.176600e-02_rb,4.057400e-02_rb,3.942534e-02_rb,3.832066e-02_rb,3.725068e-02_rb,&
+       & 3.621400e-02_rb,3.520533e-02_rb,3.422333e-02_rb,3.326400e-02_rb,3.232467e-02_rb,&
+       & 3.140535e-02_rb,3.050400e-02_rb,2.962000e-02_rb,2.875267e-02_rb,2.789800e-02_rb,&
+       & 2.705934e-02_rb,2.623667e-02_rb,2.542667e-02_rb,2.463200e-02_rb,2.385267e-02_rb,&
+       & 2.308667e-02_rb,2.233667e-02_rb,2.160067e-02_rb /)
+!     BAND  18
+      extliq1(:, 18) = (/ &
+       & 9.250861e-01_rb,6.245692e-01_rb,4.347038e-01_rb,3.320208e-01_rb,2.714869e-01_rb,&
+       & 2.309516e-01_rb,2.012592e-01_rb,1.783315e-01_rb,1.600369e-01_rb,1.451000e-01_rb,&
+       & 1.326838e-01_rb,1.222069e-01_rb,1.132554e-01_rb,1.055146e-01_rb,9.876000e-02_rb,&
+       & 9.281386e-02_rb,8.754000e-02_rb,8.283078e-02_rb,7.860077e-02_rb,7.477769e-02_rb,&
+       & 7.130847e-02_rb,6.814461e-02_rb,6.524615e-02_rb,6.258462e-02_rb,6.012847e-02_rb,&
+       & 5.785462e-02_rb,5.574231e-02_rb,5.378000e-02_rb,5.194461e-02_rb,5.022462e-02_rb,&
+       & 4.860846e-02_rb,4.708462e-02_rb,4.564154e-02_rb,4.427462e-02_rb,4.297231e-02_rb,&
+       & 4.172769e-02_rb,4.053693e-02_rb,3.939000e-02_rb,3.828462e-02_rb,3.721692e-02_rb,&
+       & 3.618000e-02_rb,3.517077e-02_rb,3.418923e-02_rb,3.323077e-02_rb,3.229154e-02_rb,&
+       & 3.137154e-02_rb,3.047154e-02_rb,2.959077e-02_rb,2.872308e-02_rb,2.786846e-02_rb,&
+       & 2.703077e-02_rb,2.620923e-02_rb,2.540077e-02_rb,2.460615e-02_rb,2.382693e-02_rb,&
+       & 2.306231e-02_rb,2.231231e-02_rb,2.157923e-02_rb /)
+!     BAND  19
+      extliq1(:, 19) = (/ &
+       & 9.298960e-01_rb,5.776460e-01_rb,4.083450e-01_rb,3.211160e-01_rb,2.666390e-01_rb,&
+       & 2.281990e-01_rb,1.993250e-01_rb,1.768080e-01_rb,1.587810e-01_rb,1.440390e-01_rb,&
+       & 1.317720e-01_rb,1.214150e-01_rb,1.125540e-01_rb,1.048890e-01_rb,9.819600e-02_rb,&
+       & 9.230201e-02_rb,8.706900e-02_rb,8.239698e-02_rb,7.819500e-02_rb,7.439899e-02_rb,&
+       & 7.095300e-02_rb,6.780700e-02_rb,6.492900e-02_rb,6.228600e-02_rb,5.984600e-02_rb,&
+       & 5.758599e-02_rb,5.549099e-02_rb,5.353801e-02_rb,5.171400e-02_rb,5.000500e-02_rb,&
+       & 4.840000e-02_rb,4.688500e-02_rb,4.545100e-02_rb,4.409300e-02_rb,4.279700e-02_rb,&
+       & 4.156100e-02_rb,4.037700e-02_rb,3.923800e-02_rb,3.813800e-02_rb,3.707600e-02_rb,&
+       & 3.604500e-02_rb,3.504300e-02_rb,3.406500e-02_rb,3.310800e-02_rb,3.217700e-02_rb,&
+       & 3.126600e-02_rb,3.036800e-02_rb,2.948900e-02_rb,2.862400e-02_rb,2.777500e-02_rb,&
+       & 2.694200e-02_rb,2.612300e-02_rb,2.531700e-02_rb,2.452800e-02_rb,2.375100e-02_rb,&
+       & 2.299100e-02_rb,2.224300e-02_rb,2.151201e-02_rb /)
+!     BAND  20
+      extliq1(:, 20) = (/ &
+       & 8.780964e-01_rb,5.407031e-01_rb,3.961100e-01_rb,3.166645e-01_rb,2.640455e-01_rb,&
+       & 2.261070e-01_rb,1.974820e-01_rb,1.751775e-01_rb,1.573415e-01_rb,1.427725e-01_rb,&
+       & 1.306535e-01_rb,1.204195e-01_rb,1.116650e-01_rb,1.040915e-01_rb,9.747550e-02_rb,&
+       & 9.164800e-02_rb,8.647649e-02_rb,8.185501e-02_rb,7.770200e-02_rb,7.394749e-02_rb,&
+       & 7.053800e-02_rb,6.742700e-02_rb,6.457999e-02_rb,6.196149e-02_rb,5.954450e-02_rb,&
+       & 5.730650e-02_rb,5.522949e-02_rb,5.329450e-02_rb,5.148500e-02_rb,4.979000e-02_rb,&
+       & 4.819600e-02_rb,4.669301e-02_rb,4.527050e-02_rb,4.391899e-02_rb,4.263500e-02_rb,&
+       & 4.140500e-02_rb,4.022850e-02_rb,3.909500e-02_rb,3.800199e-02_rb,3.694600e-02_rb,&
+       & 3.592000e-02_rb,3.492250e-02_rb,3.395050e-02_rb,3.300150e-02_rb,3.207250e-02_rb,&
+       & 3.116250e-02_rb,3.027100e-02_rb,2.939500e-02_rb,2.853500e-02_rb,2.768900e-02_rb,&
+       & 2.686000e-02_rb,2.604350e-02_rb,2.524150e-02_rb,2.445350e-02_rb,2.368049e-02_rb,&
+       & 2.292150e-02_rb,2.217800e-02_rb,2.144800e-02_rb /)
+!     BAND  21
+      extliq1(:, 21) = (/ &
+       & 7.937480e-01_rb,5.123036e-01_rb,3.858181e-01_rb,3.099622e-01_rb,2.586829e-01_rb,&
+       & 2.217587e-01_rb,1.939755e-01_rb,1.723397e-01_rb,1.550258e-01_rb,1.408600e-01_rb,&
+       & 1.290545e-01_rb,1.190661e-01_rb,1.105039e-01_rb,1.030848e-01_rb,9.659387e-02_rb,&
+       & 9.086775e-02_rb,8.577807e-02_rb,8.122452e-02_rb,7.712711e-02_rb,7.342193e-02_rb,&
+       & 7.005387e-02_rb,6.697840e-02_rb,6.416000e-02_rb,6.156903e-02_rb,5.917484e-02_rb,&
+       & 5.695807e-02_rb,5.489968e-02_rb,5.298097e-02_rb,5.118806e-02_rb,4.950645e-02_rb,&
+       & 4.792710e-02_rb,4.643581e-02_rb,4.502484e-02_rb,4.368547e-02_rb,4.241001e-02_rb,&
+       & 4.118936e-02_rb,4.002193e-02_rb,3.889711e-02_rb,3.781322e-02_rb,3.676387e-02_rb,&
+       & 3.574549e-02_rb,3.475548e-02_rb,3.379033e-02_rb,3.284678e-02_rb,3.192420e-02_rb,&
+       & 3.102032e-02_rb,3.013484e-02_rb,2.926258e-02_rb,2.840839e-02_rb,2.756742e-02_rb,&
+       & 2.674258e-02_rb,2.593064e-02_rb,2.513258e-02_rb,2.435000e-02_rb,2.358064e-02_rb,&
+       & 2.282581e-02_rb,2.208548e-02_rb,2.135936e-02_rb /)
+!     BAND  22
+      extliq1(:, 22) = (/ &
+       & 7.533129e-01_rb,5.033129e-01_rb,3.811271e-01_rb,3.062757e-01_rb,2.558729e-01_rb,&
+       & 2.196828e-01_rb,1.924372e-01_rb,1.711714e-01_rb,1.541086e-01_rb,1.401114e-01_rb,&
+       & 1.284257e-01_rb,1.185200e-01_rb,1.100243e-01_rb,1.026529e-01_rb,9.620142e-02_rb,&
+       & 9.050714e-02_rb,8.544428e-02_rb,8.091714e-02_rb,7.684000e-02_rb,7.315429e-02_rb,&
+       & 6.980143e-02_rb,6.673999e-02_rb,6.394000e-02_rb,6.136000e-02_rb,5.897715e-02_rb,&
+       & 5.677000e-02_rb,5.472285e-02_rb,5.281286e-02_rb,5.102858e-02_rb,4.935429e-02_rb,&
+       & 4.778000e-02_rb,4.629714e-02_rb,4.489142e-02_rb,4.355857e-02_rb,4.228715e-02_rb,&
+       & 4.107285e-02_rb,3.990857e-02_rb,3.879000e-02_rb,3.770999e-02_rb,3.666429e-02_rb,&
+       & 3.565000e-02_rb,3.466286e-02_rb,3.370143e-02_rb,3.276143e-02_rb,3.184143e-02_rb,&
+       & 3.094000e-02_rb,3.005714e-02_rb,2.919000e-02_rb,2.833714e-02_rb,2.750000e-02_rb,&
+       & 2.667714e-02_rb,2.586714e-02_rb,2.507143e-02_rb,2.429143e-02_rb,2.352428e-02_rb,&
+       & 2.277143e-02_rb,2.203429e-02_rb,2.130857e-02_rb /)
+!     BAND  23
+      extliq1(:, 23) = (/ &
+       & 7.079894e-01_rb,4.878198e-01_rb,3.719852e-01_rb,3.001873e-01_rb,2.514795e-01_rb,&
+       & 2.163013e-01_rb,1.897100e-01_rb,1.689033e-01_rb,1.521793e-01_rb,1.384449e-01_rb,&
+       & 1.269666e-01_rb,1.172326e-01_rb,1.088745e-01_rb,1.016224e-01_rb,9.527085e-02_rb,&
+       & 8.966240e-02_rb,8.467543e-02_rb,8.021144e-02_rb,7.619344e-02_rb,7.255676e-02_rb,&
+       & 6.924996e-02_rb,6.623030e-02_rb,6.346261e-02_rb,6.091499e-02_rb,5.856325e-02_rb,&
+       & 5.638385e-02_rb,5.435930e-02_rb,5.247156e-02_rb,5.070699e-02_rb,4.905230e-02_rb,&
+       & 4.749499e-02_rb,4.602611e-02_rb,4.463581e-02_rb,4.331543e-02_rb,4.205647e-02_rb,&
+       & 4.085241e-02_rb,3.969978e-02_rb,3.859033e-02_rb,3.751877e-02_rb,3.648168e-02_rb,&
+       & 3.547468e-02_rb,3.449553e-02_rb,3.354072e-02_rb,3.260732e-02_rb,3.169438e-02_rb,&
+       & 3.079969e-02_rb,2.992146e-02_rb,2.905875e-02_rb,2.821201e-02_rb,2.737873e-02_rb,&
+       & 2.656052e-02_rb,2.575586e-02_rb,2.496511e-02_rb,2.418783e-02_rb,2.342500e-02_rb,&
+       & 2.267646e-02_rb,2.194177e-02_rb,2.122146e-02_rb /)
+!     BAND  24
+      extliq1(:, 24) = (/ &
+       & 6.850164e-01_rb,4.762468e-01_rb,3.642001e-01_rb,2.946012e-01_rb,2.472001e-01_rb,&
+       & 2.128588e-01_rb,1.868537e-01_rb,1.664893e-01_rb,1.501142e-01_rb,1.366620e-01_rb,&
+       & 1.254147e-01_rb,1.158721e-01_rb,1.076732e-01_rb,1.005530e-01_rb,9.431306e-02_rb,&
+       & 8.879891e-02_rb,8.389232e-02_rb,7.949714e-02_rb,7.553857e-02_rb,7.195474e-02_rb,&
+       & 6.869413e-02_rb,6.571444e-02_rb,6.298286e-02_rb,6.046779e-02_rb,5.814474e-02_rb,&
+       & 5.599141e-02_rb,5.399114e-02_rb,5.212443e-02_rb,5.037870e-02_rb,4.874321e-02_rb,&
+       & 4.720219e-02_rb,4.574813e-02_rb,4.437160e-02_rb,4.306460e-02_rb,4.181810e-02_rb,&
+       & 4.062603e-02_rb,3.948252e-02_rb,3.838256e-02_rb,3.732049e-02_rb,3.629192e-02_rb,&
+       & 3.529301e-02_rb,3.432190e-02_rb,3.337412e-02_rb,3.244842e-02_rb,3.154175e-02_rb,&
+       & 3.065253e-02_rb,2.978063e-02_rb,2.892367e-02_rb,2.808221e-02_rb,2.725478e-02_rb,&
+       & 2.644174e-02_rb,2.564175e-02_rb,2.485508e-02_rb,2.408303e-02_rb,2.332365e-02_rb,&
+       & 2.257890e-02_rb,2.184824e-02_rb,2.113224e-02_rb /)
+!     BAND  25
+      extliq1(:, 25) = (/ &
+       & 6.673017e-01_rb,4.664520e-01_rb,3.579398e-01_rb,2.902234e-01_rb,2.439904e-01_rb,&
+       & 2.104149e-01_rb,1.849277e-01_rb,1.649234e-01_rb,1.488087e-01_rb,1.355515e-01_rb,&
+       & 1.244562e-01_rb,1.150329e-01_rb,1.069321e-01_rb,9.989310e-02_rb,9.372070e-02_rb,&
+       & 8.826450e-02_rb,8.340622e-02_rb,7.905378e-02_rb,7.513109e-02_rb,7.157859e-02_rb,&
+       & 6.834588e-02_rb,6.539114e-02_rb,6.268150e-02_rb,6.018621e-02_rb,5.788098e-02_rb,&
+       & 5.574351e-02_rb,5.375699e-02_rb,5.190412e-02_rb,5.017099e-02_rb,4.854497e-02_rb,&
+       & 4.701490e-02_rb,4.557030e-02_rb,4.420249e-02_rb,4.290304e-02_rb,4.166427e-02_rb,&
+       & 4.047820e-02_rb,3.934232e-02_rb,3.824778e-02_rb,3.719236e-02_rb,3.616931e-02_rb,&
+       & 3.517597e-02_rb,3.420856e-02_rb,3.326566e-02_rb,3.234346e-02_rb,3.144122e-02_rb,&
+       & 3.055684e-02_rb,2.968798e-02_rb,2.883519e-02_rb,2.799635e-02_rb,2.717228e-02_rb,&
+       & 2.636182e-02_rb,2.556424e-02_rb,2.478114e-02_rb,2.401086e-02_rb,2.325657e-02_rb,&
+       & 2.251506e-02_rb,2.178594e-02_rb,2.107301e-02_rb /)
+!     BAND  26
+      extliq1(:, 26) = (/ &
+       & 6.552414e-01_rb,4.599454e-01_rb,3.538626e-01_rb,2.873547e-01_rb,2.418033e-01_rb,&
+       & 2.086660e-01_rb,1.834885e-01_rb,1.637142e-01_rb,1.477767e-01_rb,1.346583e-01_rb,&
+       & 1.236734e-01_rb,1.143412e-01_rb,1.063148e-01_rb,9.933905e-02_rb,9.322026e-02_rb,&
+       & 8.780979e-02_rb,8.299230e-02_rb,7.867554e-02_rb,7.478450e-02_rb,7.126053e-02_rb,&
+       & 6.805276e-02_rb,6.512143e-02_rb,6.243211e-02_rb,5.995541e-02_rb,5.766712e-02_rb,&
+       & 5.554484e-02_rb,5.357246e-02_rb,5.173222e-02_rb,5.001069e-02_rb,4.839505e-02_rb,&
+       & 4.687471e-02_rb,4.543861e-02_rb,4.407857e-02_rb,4.278577e-02_rb,4.155331e-02_rb,&
+       & 4.037322e-02_rb,3.924302e-02_rb,3.815376e-02_rb,3.710172e-02_rb,3.608296e-02_rb,&
+       & 3.509330e-02_rb,3.412980e-02_rb,3.319009e-02_rb,3.227106e-02_rb,3.137157e-02_rb,&
+       & 3.048950e-02_rb,2.962365e-02_rb,2.877297e-02_rb,2.793726e-02_rb,2.711500e-02_rb,&
+       & 2.630666e-02_rb,2.551206e-02_rb,2.473052e-02_rb,2.396287e-02_rb,2.320861e-02_rb,&
+       & 2.246810e-02_rb,2.174162e-02_rb,2.102927e-02_rb /)
+!     BAND  27
+      extliq1(:, 27) = (/ &
+       & 6.430901e-01_rb,4.532134e-01_rb,3.496132e-01_rb,2.844655e-01_rb,2.397347e-01_rb,&
+       & 2.071236e-01_rb,1.822976e-01_rb,1.627640e-01_rb,1.469961e-01_rb,1.340006e-01_rb,&
+       & 1.231069e-01_rb,1.138441e-01_rb,1.058706e-01_rb,9.893678e-02_rb,9.285166e-02_rb,&
+       & 8.746871e-02_rb,8.267411e-02_rb,7.837656e-02_rb,7.450257e-02_rb,7.099318e-02_rb,&
+       & 6.779929e-02_rb,6.487987e-02_rb,6.220168e-02_rb,5.973530e-02_rb,5.745636e-02_rb,&
+       & 5.534344e-02_rb,5.337986e-02_rb,5.154797e-02_rb,4.983404e-02_rb,4.822582e-02_rb,&
+       & 4.671228e-02_rb,4.528321e-02_rb,4.392997e-02_rb,4.264325e-02_rb,4.141647e-02_rb,&
+       & 4.024259e-02_rb,3.911767e-02_rb,3.803309e-02_rb,3.698782e-02_rb,3.597140e-02_rb,&
+       & 3.498774e-02_rb,3.402852e-02_rb,3.309340e-02_rb,3.217818e-02_rb,3.128292e-02_rb,&
+       & 3.040486e-02_rb,2.954230e-02_rb,2.869545e-02_rb,2.786261e-02_rb,2.704372e-02_rb,&
+       & 2.623813e-02_rb,2.544668e-02_rb,2.466788e-02_rb,2.390313e-02_rb,2.315136e-02_rb,&
+       & 2.241391e-02_rb,2.168921e-02_rb,2.097903e-02_rb /)
+!     BAND  28
+      extliq1(:, 28) = (/ &
+       & 6.367074e-01_rb,4.495768e-01_rb,3.471263e-01_rb,2.826149e-01_rb,2.382868e-01_rb,&
+       & 2.059640e-01_rb,1.813562e-01_rb,1.619881e-01_rb,1.463436e-01_rb,1.334402e-01_rb,&
+       & 1.226166e-01_rb,1.134096e-01_rb,1.054829e-01_rb,9.858838e-02_rb,9.253790e-02_rb,&
+       & 8.718582e-02_rb,8.241830e-02_rb,7.814482e-02_rb,7.429212e-02_rb,7.080165e-02_rb,&
+       & 6.762385e-02_rb,6.471838e-02_rb,6.205388e-02_rb,5.959726e-02_rb,5.732871e-02_rb,&
+       & 5.522402e-02_rb,5.326793e-02_rb,5.144230e-02_rb,4.973440e-02_rb,4.813188e-02_rb,&
+       & 4.662283e-02_rb,4.519798e-02_rb,4.384833e-02_rb,4.256541e-02_rb,4.134253e-02_rb,&
+       & 4.017136e-02_rb,3.904911e-02_rb,3.796779e-02_rb,3.692364e-02_rb,3.591182e-02_rb,&
+       & 3.492930e-02_rb,3.397230e-02_rb,3.303920e-02_rb,3.212572e-02_rb,3.123278e-02_rb,&
+       & 3.035519e-02_rb,2.949493e-02_rb,2.864985e-02_rb,2.781840e-02_rb,2.700197e-02_rb,&
+       & 2.619682e-02_rb,2.540674e-02_rb,2.462966e-02_rb,2.386613e-02_rb,2.311602e-02_rb,&
+       & 2.237846e-02_rb,2.165660e-02_rb,2.094756e-02_rb /)
+!     BAND  29
+      extliq1(:, 29) = (/ &
+       & 4.298416e-01_rb,4.391639e-01_rb,3.975030e-01_rb,3.443028e-01_rb,2.957345e-01_rb,&
+       & 2.556461e-01_rb,2.234755e-01_rb,1.976636e-01_rb,1.767428e-01_rb,1.595611e-01_rb,&
+       & 1.452636e-01_rb,1.332156e-01_rb,1.229481e-01_rb,1.141059e-01_rb,1.064208e-01_rb,&
+       & 9.968527e-02_rb,9.373833e-02_rb,8.845221e-02_rb,8.372112e-02_rb,7.946667e-02_rb,&
+       & 7.561807e-02_rb,7.212029e-02_rb,6.893166e-02_rb,6.600944e-02_rb,6.332277e-02_rb,&
+       & 6.084277e-02_rb,5.854721e-02_rb,5.641361e-02_rb,5.442639e-02_rb,5.256750e-02_rb,&
+       & 5.082499e-02_rb,4.918556e-02_rb,4.763694e-02_rb,4.617222e-02_rb,4.477861e-02_rb,&
+       & 4.344861e-02_rb,4.217999e-02_rb,4.096111e-02_rb,3.978638e-02_rb,3.865361e-02_rb,&
+       & 3.755473e-02_rb,3.649028e-02_rb,3.545361e-02_rb,3.444361e-02_rb,3.345666e-02_rb,&
+       & 3.249167e-02_rb,3.154722e-02_rb,3.062083e-02_rb,2.971250e-02_rb,2.882083e-02_rb,&
+       & 2.794611e-02_rb,2.708778e-02_rb,2.624500e-02_rb,2.541750e-02_rb,2.460528e-02_rb,&
+       & 2.381194e-02_rb,2.303250e-02_rb,2.226833e-02_rb /)
+!     BAND  16
+      ssaliq1(:, 16) = (/ &
+       & 8.362119e-01_rb,8.098460e-01_rb,7.762291e-01_rb,7.486042e-01_rb,7.294172e-01_rb,&
+       & 7.161000e-01_rb,7.060656e-01_rb,6.978387e-01_rb,6.907193e-01_rb,6.843551e-01_rb,&
+       & 6.785668e-01_rb,6.732450e-01_rb,6.683191e-01_rb,6.637264e-01_rb,6.594307e-01_rb,&
+       & 6.554033e-01_rb,6.516115e-01_rb,6.480295e-01_rb,6.446429e-01_rb,6.414306e-01_rb,&
+       & 6.383783e-01_rb,6.354750e-01_rb,6.327068e-01_rb,6.300665e-01_rb,6.275376e-01_rb,&
+       & 6.251245e-01_rb,6.228136e-01_rb,6.205944e-01_rb,6.184720e-01_rb,6.164330e-01_rb,&
+       & 6.144742e-01_rb,6.125962e-01_rb,6.108004e-01_rb,6.090740e-01_rb,6.074200e-01_rb,&
+       & 6.058381e-01_rb,6.043209e-01_rb,6.028681e-01_rb,6.014836e-01_rb,6.001626e-01_rb,&
+       & 5.988957e-01_rb,5.976864e-01_rb,5.965390e-01_rb,5.954379e-01_rb,5.943972e-01_rb,&
+       & 5.934019e-01_rb,5.924624e-01_rb,5.915579e-01_rb,5.907025e-01_rb,5.898913e-01_rb,&
+       & 5.891213e-01_rb,5.883815e-01_rb,5.876851e-01_rb,5.870158e-01_rb,5.863868e-01_rb,&
+       & 5.857821e-01_rb,5.852111e-01_rb,5.846579e-01_rb /)
+!     BAND  17
+      ssaliq1(:, 17) = (/ &
+       & 6.995459e-01_rb,7.158012e-01_rb,7.076001e-01_rb,6.927244e-01_rb,6.786434e-01_rb,&
+       & 6.673545e-01_rb,6.585859e-01_rb,6.516314e-01_rb,6.459010e-01_rb,6.410225e-01_rb,&
+       & 6.367574e-01_rb,6.329554e-01_rb,6.295119e-01_rb,6.263595e-01_rb,6.234462e-01_rb,&
+       & 6.207274e-01_rb,6.181755e-01_rb,6.157678e-01_rb,6.134880e-01_rb,6.113173e-01_rb,&
+       & 6.092495e-01_rb,6.072689e-01_rb,6.053717e-01_rb,6.035507e-01_rb,6.018001e-01_rb,&
+       & 6.001134e-01_rb,5.984951e-01_rb,5.969294e-01_rb,5.954256e-01_rb,5.939698e-01_rb,&
+       & 5.925716e-01_rb,5.912265e-01_rb,5.899270e-01_rb,5.886771e-01_rb,5.874746e-01_rb,&
+       & 5.863185e-01_rb,5.852077e-01_rb,5.841460e-01_rb,5.831249e-01_rb,5.821474e-01_rb,&
+       & 5.812078e-01_rb,5.803173e-01_rb,5.794616e-01_rb,5.786443e-01_rb,5.778617e-01_rb,&
+       & 5.771236e-01_rb,5.764191e-01_rb,5.757400e-01_rb,5.750971e-01_rb,5.744842e-01_rb,&
+       & 5.739012e-01_rb,5.733482e-01_rb,5.728175e-01_rb,5.723214e-01_rb,5.718383e-01_rb,&
+       & 5.713827e-01_rb,5.709471e-01_rb,5.705330e-01_rb /)
+!     BAND  18
+      ssaliq1(:, 18) = (/ &
+       & 9.929711e-01_rb,9.896942e-01_rb,9.852408e-01_rb,9.806820e-01_rb,9.764512e-01_rb,&
+       & 9.725375e-01_rb,9.688677e-01_rb,9.653832e-01_rb,9.620552e-01_rb,9.588522e-01_rb,&
+       & 9.557475e-01_rb,9.527265e-01_rb,9.497731e-01_rb,9.468756e-01_rb,9.440270e-01_rb,&
+       & 9.412230e-01_rb,9.384592e-01_rb,9.357287e-01_rb,9.330369e-01_rb,9.303778e-01_rb,&
+       & 9.277502e-01_rb,9.251546e-01_rb,9.225907e-01_rb,9.200553e-01_rb,9.175521e-01_rb,&
+       & 9.150773e-01_rb,9.126352e-01_rb,9.102260e-01_rb,9.078485e-01_rb,9.055057e-01_rb,&
+       & 9.031978e-01_rb,9.009306e-01_rb,8.987010e-01_rb,8.965177e-01_rb,8.943774e-01_rb,&
+       & 8.922869e-01_rb,8.902430e-01_rb,8.882551e-01_rb,8.863182e-01_rb,8.844373e-01_rb,&
+       & 8.826143e-01_rb,8.808499e-01_rb,8.791413e-01_rb,8.774940e-01_rb,8.759019e-01_rb,&
+       & 8.743650e-01_rb,8.728941e-01_rb,8.714712e-01_rb,8.701065e-01_rb,8.688008e-01_rb,&
+       & 8.675409e-01_rb,8.663295e-01_rb,8.651714e-01_rb,8.640637e-01_rb,8.629943e-01_rb,&
+       & 8.619762e-01_rb,8.609995e-01_rb,8.600581e-01_rb /)
+!     BAND  19
+      ssaliq1(:, 19) = (/ &
+       & 9.910612e-01_rb,9.854226e-01_rb,9.795008e-01_rb,9.742920e-01_rb,9.695996e-01_rb,&
+       & 9.652274e-01_rb,9.610648e-01_rb,9.570521e-01_rb,9.531397e-01_rb,9.493086e-01_rb,&
+       & 9.455413e-01_rb,9.418362e-01_rb,9.381902e-01_rb,9.346016e-01_rb,9.310718e-01_rb,&
+       & 9.275957e-01_rb,9.241757e-01_rb,9.208038e-01_rb,9.174802e-01_rb,9.142058e-01_rb,&
+       & 9.109753e-01_rb,9.077895e-01_rb,9.046433e-01_rb,9.015409e-01_rb,8.984784e-01_rb,&
+       & 8.954572e-01_rb,8.924748e-01_rb,8.895367e-01_rb,8.866395e-01_rb,8.837864e-01_rb,&
+       & 8.809819e-01_rb,8.782267e-01_rb,8.755231e-01_rb,8.728712e-01_rb,8.702802e-01_rb,&
+       & 8.677443e-01_rb,8.652733e-01_rb,8.628678e-01_rb,8.605300e-01_rb,8.582593e-01_rb,&
+       & 8.560596e-01_rb,8.539352e-01_rb,8.518782e-01_rb,8.498915e-01_rb,8.479790e-01_rb,&
+       & 8.461384e-01_rb,8.443645e-01_rb,8.426613e-01_rb,8.410229e-01_rb,8.394495e-01_rb,&
+       & 8.379428e-01_rb,8.364967e-01_rb,8.351117e-01_rb,8.337820e-01_rb,8.325091e-01_rb,&
+       & 8.312874e-01_rb,8.301169e-01_rb,8.289985e-01_rb /)
+!     BAND  20
+      ssaliq1(:, 20) = (/ &
+       & 9.969802e-01_rb,9.950445e-01_rb,9.931448e-01_rb,9.914272e-01_rb,9.898652e-01_rb,&
+       & 9.884250e-01_rb,9.870637e-01_rb,9.857482e-01_rb,9.844558e-01_rb,9.831755e-01_rb,&
+       & 9.819068e-01_rb,9.806477e-01_rb,9.794000e-01_rb,9.781666e-01_rb,9.769461e-01_rb,&
+       & 9.757386e-01_rb,9.745459e-01_rb,9.733650e-01_rb,9.721953e-01_rb,9.710398e-01_rb,&
+       & 9.698936e-01_rb,9.687583e-01_rb,9.676334e-01_rb,9.665192e-01_rb,9.654132e-01_rb,&
+       & 9.643208e-01_rb,9.632374e-01_rb,9.621625e-01_rb,9.611003e-01_rb,9.600518e-01_rb,&
+       & 9.590144e-01_rb,9.579922e-01_rb,9.569864e-01_rb,9.559948e-01_rb,9.550239e-01_rb,&
+       & 9.540698e-01_rb,9.531382e-01_rb,9.522280e-01_rb,9.513409e-01_rb,9.504772e-01_rb,&
+       & 9.496360e-01_rb,9.488220e-01_rb,9.480327e-01_rb,9.472693e-01_rb,9.465333e-01_rb,&
+       & 9.458211e-01_rb,9.451344e-01_rb,9.444732e-01_rb,9.438372e-01_rb,9.432268e-01_rb,&
+       & 9.426391e-01_rb,9.420757e-01_rb,9.415308e-01_rb,9.410102e-01_rb,9.405115e-01_rb,&
+       & 9.400326e-01_rb,9.395716e-01_rb,9.391313e-01_rb /)
+!     BAND  21
+      ssaliq1(:, 21) = (/ &
+       & 9.980034e-01_rb,9.968572e-01_rb,9.958696e-01_rb,9.949747e-01_rb,9.941241e-01_rb,&
+       & 9.933043e-01_rb,9.924971e-01_rb,9.916978e-01_rb,9.909023e-01_rb,9.901046e-01_rb,&
+       & 9.893087e-01_rb,9.885146e-01_rb,9.877195e-01_rb,9.869283e-01_rb,9.861379e-01_rb,&
+       & 9.853523e-01_rb,9.845715e-01_rb,9.837945e-01_rb,9.830217e-01_rb,9.822567e-01_rb,&
+       & 9.814935e-01_rb,9.807356e-01_rb,9.799815e-01_rb,9.792332e-01_rb,9.784845e-01_rb,&
+       & 9.777424e-01_rb,9.770042e-01_rb,9.762695e-01_rb,9.755416e-01_rb,9.748152e-01_rb,&
+       & 9.740974e-01_rb,9.733873e-01_rb,9.726813e-01_rb,9.719861e-01_rb,9.713010e-01_rb,&
+       & 9.706262e-01_rb,9.699647e-01_rb,9.693144e-01_rb,9.686794e-01_rb,9.680596e-01_rb,&
+       & 9.674540e-01_rb,9.668657e-01_rb,9.662926e-01_rb,9.657390e-01_rb,9.652019e-01_rb,&
+       & 9.646820e-01_rb,9.641784e-01_rb,9.636945e-01_rb,9.632260e-01_rb,9.627743e-01_rb,&
+       & 9.623418e-01_rb,9.619227e-01_rb,9.615194e-01_rb,9.611341e-01_rb,9.607629e-01_rb,&
+       & 9.604057e-01_rb,9.600622e-01_rb,9.597322e-01_rb /)
+!     BAND  22
+      ssaliq1(:, 22) = (/ &
+       & 9.988219e-01_rb,9.981767e-01_rb,9.976168e-01_rb,9.971066e-01_rb,9.966195e-01_rb,&
+       & 9.961566e-01_rb,9.956995e-01_rb,9.952481e-01_rb,9.947982e-01_rb,9.943495e-01_rb,&
+       & 9.938955e-01_rb,9.934368e-01_rb,9.929825e-01_rb,9.925239e-01_rb,9.920653e-01_rb,&
+       & 9.916096e-01_rb,9.911552e-01_rb,9.907067e-01_rb,9.902594e-01_rb,9.898178e-01_rb,&
+       & 9.893791e-01_rb,9.889453e-01_rb,9.885122e-01_rb,9.880837e-01_rb,9.876567e-01_rb,&
+       & 9.872331e-01_rb,9.868121e-01_rb,9.863938e-01_rb,9.859790e-01_rb,9.855650e-01_rb,&
+       & 9.851548e-01_rb,9.847491e-01_rb,9.843496e-01_rb,9.839521e-01_rb,9.835606e-01_rb,&
+       & 9.831771e-01_rb,9.827975e-01_rb,9.824292e-01_rb,9.820653e-01_rb,9.817124e-01_rb,&
+       & 9.813644e-01_rb,9.810291e-01_rb,9.807020e-01_rb,9.803864e-01_rb,9.800782e-01_rb,&
+       & 9.797821e-01_rb,9.794958e-01_rb,9.792179e-01_rb,9.789509e-01_rb,9.786940e-01_rb,&
+       & 9.784460e-01_rb,9.782090e-01_rb,9.779789e-01_rb,9.777553e-01_rb,9.775425e-01_rb,&
+       & 9.773387e-01_rb,9.771420e-01_rb,9.769529e-01_rb /)
+!     BAND  23
+      ssaliq1(:, 23) = (/ &
+       & 9.998902e-01_rb,9.998395e-01_rb,9.997915e-01_rb,9.997442e-01_rb,9.997016e-01_rb,&
+       & 9.996600e-01_rb,9.996200e-01_rb,9.995806e-01_rb,9.995411e-01_rb,9.995005e-01_rb,&
+       & 9.994589e-01_rb,9.994178e-01_rb,9.993766e-01_rb,9.993359e-01_rb,9.992948e-01_rb,&
+       & 9.992533e-01_rb,9.992120e-01_rb,9.991723e-01_rb,9.991313e-01_rb,9.990906e-01_rb,&
+       & 9.990510e-01_rb,9.990113e-01_rb,9.989716e-01_rb,9.989323e-01_rb,9.988923e-01_rb,&
+       & 9.988532e-01_rb,9.988140e-01_rb,9.987761e-01_rb,9.987373e-01_rb,9.986989e-01_rb,&
+       & 9.986597e-01_rb,9.986239e-01_rb,9.985861e-01_rb,9.985485e-01_rb,9.985123e-01_rb,&
+       & 9.984762e-01_rb,9.984415e-01_rb,9.984065e-01_rb,9.983722e-01_rb,9.983398e-01_rb,&
+       & 9.983078e-01_rb,9.982758e-01_rb,9.982461e-01_rb,9.982157e-01_rb,9.981872e-01_rb,&
+       & 9.981595e-01_rb,9.981324e-01_rb,9.981068e-01_rb,9.980811e-01_rb,9.980580e-01_rb,&
+       & 9.980344e-01_rb,9.980111e-01_rb,9.979908e-01_rb,9.979690e-01_rb,9.979492e-01_rb,&
+       & 9.979316e-01_rb,9.979116e-01_rb,9.978948e-01_rb /)
+!     BAND  24
+      ssaliq1(:, 24) = (/ &
+       & 9.999978e-01_rb,9.999948e-01_rb,9.999915e-01_rb,9.999905e-01_rb,9.999896e-01_rb,&
+       & 9.999887e-01_rb,9.999888e-01_rb,9.999888e-01_rb,9.999870e-01_rb,9.999854e-01_rb,&
+       & 9.999855e-01_rb,9.999856e-01_rb,9.999839e-01_rb,9.999834e-01_rb,9.999829e-01_rb,&
+       & 9.999809e-01_rb,9.999816e-01_rb,9.999793e-01_rb,9.999782e-01_rb,9.999779e-01_rb,&
+       & 9.999772e-01_rb,9.999764e-01_rb,9.999756e-01_rb,9.999744e-01_rb,9.999744e-01_rb,&
+       & 9.999736e-01_rb,9.999729e-01_rb,9.999716e-01_rb,9.999706e-01_rb,9.999692e-01_rb,&
+       & 9.999690e-01_rb,9.999675e-01_rb,9.999673e-01_rb,9.999660e-01_rb,9.999654e-01_rb,&
+       & 9.999647e-01_rb,9.999647e-01_rb,9.999625e-01_rb,9.999620e-01_rb,9.999614e-01_rb,&
+       & 9.999613e-01_rb,9.999607e-01_rb,9.999604e-01_rb,9.999594e-01_rb,9.999589e-01_rb,&
+       & 9.999586e-01_rb,9.999567e-01_rb,9.999550e-01_rb,9.999557e-01_rb,9.999542e-01_rb,&
+       & 9.999546e-01_rb,9.999539e-01_rb,9.999536e-01_rb,9.999526e-01_rb,9.999523e-01_rb,&
+       & 9.999508e-01_rb,9.999534e-01_rb,9.999507e-01_rb /)
+!     BAND  25
+      ssaliq1(:, 25) = (/ &
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,&
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,&
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,&
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,9.999995e-01_rb,&
+       & 9.999995e-01_rb,9.999990e-01_rb,9.999991e-01_rb,9.999991e-01_rb,9.999990e-01_rb,&
+       & 9.999989e-01_rb,9.999988e-01_rb,9.999988e-01_rb,9.999986e-01_rb,9.999988e-01_rb,&
+       & 9.999986e-01_rb,9.999987e-01_rb,9.999986e-01_rb,9.999985e-01_rb,9.999985e-01_rb,&
+       & 9.999985e-01_rb,9.999985e-01_rb,9.999983e-01_rb,9.999983e-01_rb,9.999981e-01_rb,&
+       & 9.999981e-01_rb,9.999986e-01_rb,9.999985e-01_rb,9.999983e-01_rb,9.999984e-01_rb,&
+       & 9.999982e-01_rb,9.999983e-01_rb,9.999982e-01_rb,9.999980e-01_rb,9.999981e-01_rb,&
+       & 9.999978e-01_rb,9.999979e-01_rb,9.999985e-01_rb,9.999985e-01_rb,9.999983e-01_rb,&
+       & 9.999983e-01_rb,9.999983e-01_rb,9.999983e-01_rb /)
+!     BAND  26
+      ssaliq1(:, 26) = (/ &
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,&
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,&
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,&
+       & 1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,1.000000e+00_rb,9.999991e-01_rb,&
+       & 9.999990e-01_rb,9.999992e-01_rb,9.999995e-01_rb,9.999986e-01_rb,9.999994e-01_rb,&
+       & 9.999985e-01_rb,9.999980e-01_rb,9.999984e-01_rb,9.999983e-01_rb,9.999979e-01_rb,&
+       & 9.999969e-01_rb,9.999977e-01_rb,9.999971e-01_rb,9.999969e-01_rb,9.999969e-01_rb,&
+       & 9.999965e-01_rb,9.999970e-01_rb,9.999985e-01_rb,9.999973e-01_rb,9.999961e-01_rb,&
+       & 9.999968e-01_rb,9.999952e-01_rb,9.999970e-01_rb,9.999974e-01_rb,9.999965e-01_rb,&
+       & 9.999969e-01_rb,9.999970e-01_rb,9.999970e-01_rb,9.999960e-01_rb,9.999923e-01_rb,&
+       & 9.999958e-01_rb,9.999937e-01_rb,9.999960e-01_rb,9.999953e-01_rb,9.999946e-01_rb,&
+       & 9.999946e-01_rb,9.999957e-01_rb,9.999951e-01_rb /)
+!     BAND  27
+      ssaliq1(:, 27) = (/ &
+       & 1.000000e+00_rb,1.000000e+00_rb,9.999983e-01_rb,9.999979e-01_rb,9.999965e-01_rb,&
+       & 9.999949e-01_rb,9.999948e-01_rb,9.999918e-01_rb,9.999917e-01_rb,9.999923e-01_rb,&
+       & 9.999908e-01_rb,9.999889e-01_rb,9.999902e-01_rb,9.999895e-01_rb,9.999881e-01_rb,&
+       & 9.999882e-01_rb,9.999876e-01_rb,9.999866e-01_rb,9.999866e-01_rb,9.999858e-01_rb,&
+       & 9.999860e-01_rb,9.999852e-01_rb,9.999836e-01_rb,9.999831e-01_rb,9.999818e-01_rb,&
+       & 9.999808e-01_rb,9.999816e-01_rb,9.999800e-01_rb,9.999783e-01_rb,9.999780e-01_rb,&
+       & 9.999763e-01_rb,9.999746e-01_rb,9.999731e-01_rb,9.999713e-01_rb,9.999762e-01_rb,&
+       & 9.999740e-01_rb,9.999670e-01_rb,9.999703e-01_rb,9.999687e-01_rb,9.999666e-01_rb,&
+       & 9.999683e-01_rb,9.999667e-01_rb,9.999611e-01_rb,9.999635e-01_rb,9.999600e-01_rb,&
+       & 9.999635e-01_rb,9.999594e-01_rb,9.999601e-01_rb,9.999586e-01_rb,9.999559e-01_rb,&
+       & 9.999569e-01_rb,9.999558e-01_rb,9.999523e-01_rb,9.999535e-01_rb,9.999529e-01_rb,&
+       & 9.999553e-01_rb,9.999495e-01_rb,9.999490e-01_rb /)
+!     BAND  28
+      ssaliq1(:, 28) = (/ &
+       & 9.999920e-01_rb,9.999873e-01_rb,9.999855e-01_rb,9.999832e-01_rb,9.999807e-01_rb,&
+       & 9.999778e-01_rb,9.999754e-01_rb,9.999721e-01_rb,9.999692e-01_rb,9.999651e-01_rb,&
+       & 9.999621e-01_rb,9.999607e-01_rb,9.999567e-01_rb,9.999546e-01_rb,9.999521e-01_rb,&
+       & 9.999491e-01_rb,9.999457e-01_rb,9.999439e-01_rb,9.999403e-01_rb,9.999374e-01_rb,&
+       & 9.999353e-01_rb,9.999315e-01_rb,9.999282e-01_rb,9.999244e-01_rb,9.999234e-01_rb,&
+       & 9.999189e-01_rb,9.999130e-01_rb,9.999117e-01_rb,9.999073e-01_rb,9.999020e-01_rb,&
+       & 9.998993e-01_rb,9.998987e-01_rb,9.998922e-01_rb,9.998893e-01_rb,9.998869e-01_rb,&
+       & 9.998805e-01_rb,9.998778e-01_rb,9.998751e-01_rb,9.998708e-01_rb,9.998676e-01_rb,&
+       & 9.998624e-01_rb,9.998642e-01_rb,9.998582e-01_rb,9.998547e-01_rb,9.998546e-01_rb,&
+       & 9.998477e-01_rb,9.998487e-01_rb,9.998466e-01_rb,9.998403e-01_rb,9.998412e-01_rb,&
+       & 9.998406e-01_rb,9.998342e-01_rb,9.998326e-01_rb,9.998333e-01_rb,9.998328e-01_rb,&
+       & 9.998290e-01_rb,9.998276e-01_rb,9.998249e-01_rb /)
+!     BAND  29
+      ssaliq1(:, 29) = (/ &
+       & 8.383753e-01_rb,8.461471e-01_rb,8.373325e-01_rb,8.212889e-01_rb,8.023834e-01_rb,&
+       & 7.829501e-01_rb,7.641777e-01_rb,7.466000e-01_rb,7.304023e-01_rb,7.155998e-01_rb,&
+       & 7.021259e-01_rb,6.898840e-01_rb,6.787615e-01_rb,6.686479e-01_rb,6.594414e-01_rb,&
+       & 6.510417e-01_rb,6.433668e-01_rb,6.363335e-01_rb,6.298788e-01_rb,6.239398e-01_rb,&
+       & 6.184633e-01_rb,6.134055e-01_rb,6.087228e-01_rb,6.043786e-01_rb,6.003439e-01_rb,&
+       & 5.965910e-01_rb,5.930917e-01_rb,5.898280e-01_rb,5.867798e-01_rb,5.839264e-01_rb,&
+       & 5.812576e-01_rb,5.787592e-01_rb,5.764163e-01_rb,5.742189e-01_rb,5.721598e-01_rb,&
+       & 5.702286e-01_rb,5.684182e-01_rb,5.667176e-01_rb,5.651237e-01_rb,5.636253e-01_rb,&
+       & 5.622228e-01_rb,5.609074e-01_rb,5.596713e-01_rb,5.585089e-01_rb,5.574223e-01_rb,&
+       & 5.564002e-01_rb,5.554411e-01_rb,5.545397e-01_rb,5.536914e-01_rb,5.528967e-01_rb,&
+       & 5.521495e-01_rb,5.514457e-01_rb,5.507818e-01_rb,5.501623e-01_rb,5.495750e-01_rb,&
+       & 5.490192e-01_rb,5.484980e-01_rb,5.480046e-01_rb /)
+!     BAND  16
+      asyliq1(:, 16) = (/ &
+       & 8.038165e-01_rb,8.014154e-01_rb,7.942381e-01_rb,7.970521e-01_rb,8.086621e-01_rb,&
+       & 8.233392e-01_rb,8.374127e-01_rb,8.495742e-01_rb,8.596945e-01_rb,8.680497e-01_rb,&
+       & 8.750005e-01_rb,8.808589e-01_rb,8.858749e-01_rb,8.902403e-01_rb,8.940939e-01_rb,&
+       & 8.975379e-01_rb,9.006450e-01_rb,9.034741e-01_rb,9.060659e-01_rb,9.084561e-01_rb,&
+       & 9.106675e-01_rb,9.127198e-01_rb,9.146332e-01_rb,9.164194e-01_rb,9.180970e-01_rb,&
+       & 9.196658e-01_rb,9.211421e-01_rb,9.225352e-01_rb,9.238443e-01_rb,9.250841e-01_rb,&
+       & 9.262541e-01_rb,9.273620e-01_rb,9.284081e-01_rb,9.294002e-01_rb,9.303395e-01_rb,&
+       & 9.312285e-01_rb,9.320715e-01_rb,9.328716e-01_rb,9.336271e-01_rb,9.343427e-01_rb,&
+       & 9.350219e-01_rb,9.356647e-01_rb,9.362728e-01_rb,9.368495e-01_rb,9.373956e-01_rb,&
+       & 9.379113e-01_rb,9.383987e-01_rb,9.388608e-01_rb,9.392986e-01_rb,9.397132e-01_rb,&
+       & 9.401063e-01_rb,9.404776e-01_rb,9.408299e-01_rb,9.411641e-01_rb,9.414800e-01_rb,&
+       & 9.417787e-01_rb,9.420633e-01_rb,9.423364e-01_rb /)
+!     BAND  17
+      asyliq1(:, 17) = (/ &
+       & 8.941000e-01_rb,9.054049e-01_rb,9.049510e-01_rb,9.027216e-01_rb,9.021636e-01_rb,&
+       & 9.037878e-01_rb,9.069852e-01_rb,9.109817e-01_rb,9.152013e-01_rb,9.193040e-01_rb,&
+       & 9.231177e-01_rb,9.265712e-01_rb,9.296606e-01_rb,9.324048e-01_rb,9.348419e-01_rb,&
+       & 9.370131e-01_rb,9.389529e-01_rb,9.406954e-01_rb,9.422727e-01_rb,9.437088e-01_rb,&
+       & 9.450221e-01_rb,9.462308e-01_rb,9.473488e-01_rb,9.483830e-01_rb,9.493492e-01_rb,&
+       & 9.502541e-01_rb,9.510999e-01_rb,9.518971e-01_rb,9.526455e-01_rb,9.533554e-01_rb,&
+       & 9.540249e-01_rb,9.546571e-01_rb,9.552551e-01_rb,9.558258e-01_rb,9.563603e-01_rb,&
+       & 9.568713e-01_rb,9.573569e-01_rb,9.578141e-01_rb,9.582485e-01_rb,9.586604e-01_rb,&
+       & 9.590525e-01_rb,9.594218e-01_rb,9.597710e-01_rb,9.601052e-01_rb,9.604181e-01_rb,&
+       & 9.607159e-01_rb,9.609979e-01_rb,9.612655e-01_rb,9.615184e-01_rb,9.617564e-01_rb,&
+       & 9.619860e-01_rb,9.622009e-01_rb,9.624031e-01_rb,9.625957e-01_rb,9.627792e-01_rb,&
+       & 9.629530e-01_rb,9.631171e-01_rb,9.632746e-01_rb /)
+!     BAND  18
+      asyliq1(:, 18) = (/ &
+       & 8.574638e-01_rb,8.351383e-01_rb,8.142977e-01_rb,8.083068e-01_rb,8.129284e-01_rb,&
+       & 8.215827e-01_rb,8.307238e-01_rb,8.389963e-01_rb,8.460481e-01_rb,8.519273e-01_rb,&
+       & 8.568153e-01_rb,8.609116e-01_rb,8.643892e-01_rb,8.673941e-01_rb,8.700248e-01_rb,&
+       & 8.723707e-01_rb,8.744902e-01_rb,8.764240e-01_rb,8.782057e-01_rb,8.798593e-01_rb,&
+       & 8.814063e-01_rb,8.828573e-01_rb,8.842261e-01_rb,8.855196e-01_rb,8.867497e-01_rb,&
+       & 8.879164e-01_rb,8.890316e-01_rb,8.900941e-01_rb,8.911118e-01_rb,8.920832e-01_rb,&
+       & 8.930156e-01_rb,8.939091e-01_rb,8.947663e-01_rb,8.955888e-01_rb,8.963786e-01_rb,&
+       & 8.971350e-01_rb,8.978617e-01_rb,8.985590e-01_rb,8.992243e-01_rb,8.998631e-01_rb,&
+       & 9.004753e-01_rb,9.010602e-01_rb,9.016192e-01_rb,9.021542e-01_rb,9.026644e-01_rb,&
+       & 9.031535e-01_rb,9.036194e-01_rb,9.040656e-01_rb,9.044894e-01_rb,9.048933e-01_rb,&
+       & 9.052789e-01_rb,9.056481e-01_rb,9.060004e-01_rb,9.063343e-01_rb,9.066544e-01_rb,&
+       & 9.069604e-01_rb,9.072512e-01_rb,9.075290e-01_rb /)
+!     BAND  19
+      asyliq1(:, 19) = (/ &
+       & 8.349569e-01_rb,8.034579e-01_rb,7.932136e-01_rb,8.010156e-01_rb,8.137083e-01_rb,&
+       & 8.255339e-01_rb,8.351938e-01_rb,8.428286e-01_rb,8.488944e-01_rb,8.538187e-01_rb,&
+       & 8.579255e-01_rb,8.614473e-01_rb,8.645338e-01_rb,8.672908e-01_rb,8.697947e-01_rb,&
+       & 8.720843e-01_rb,8.742015e-01_rb,8.761718e-01_rb,8.780160e-01_rb,8.797479e-01_rb,&
+       & 8.813810e-01_rb,8.829250e-01_rb,8.843907e-01_rb,8.857822e-01_rb,8.871059e-01_rb,&
+       & 8.883724e-01_rb,8.895810e-01_rb,8.907384e-01_rb,8.918456e-01_rb,8.929083e-01_rb,&
+       & 8.939284e-01_rb,8.949060e-01_rb,8.958463e-01_rb,8.967486e-01_rb,8.976129e-01_rb,&
+       & 8.984463e-01_rb,8.992439e-01_rb,9.000094e-01_rb,9.007438e-01_rb,9.014496e-01_rb,&
+       & 9.021235e-01_rb,9.027699e-01_rb,9.033859e-01_rb,9.039772e-01_rb,9.045419e-01_rb,&
+       & 9.050819e-01_rb,9.055975e-01_rb,9.060907e-01_rb,9.065607e-01_rb,9.070093e-01_rb,&
+       & 9.074389e-01_rb,9.078475e-01_rb,9.082388e-01_rb,9.086117e-01_rb,9.089678e-01_rb,&
+       & 9.093081e-01_rb,9.096307e-01_rb,9.099410e-01_rb /)
+!     BAND  20
+      asyliq1(:, 20) = (/ &
+       & 8.109692e-01_rb,7.846657e-01_rb,7.881928e-01_rb,8.009509e-01_rb,8.131208e-01_rb,&
+       & 8.230400e-01_rb,8.309448e-01_rb,8.372920e-01_rb,8.424837e-01_rb,8.468166e-01_rb,&
+       & 8.504947e-01_rb,8.536642e-01_rb,8.564256e-01_rb,8.588513e-01_rb,8.610011e-01_rb,&
+       & 8.629122e-01_rb,8.646262e-01_rb,8.661720e-01_rb,8.675752e-01_rb,8.688582e-01_rb,&
+       & 8.700379e-01_rb,8.711300e-01_rb,8.721485e-01_rb,8.731027e-01_rb,8.740010e-01_rb,&
+       & 8.748499e-01_rb,8.756564e-01_rb,8.764239e-01_rb,8.771542e-01_rb,8.778523e-01_rb,&
+       & 8.785211e-01_rb,8.791601e-01_rb,8.797725e-01_rb,8.803589e-01_rb,8.809173e-01_rb,&
+       & 8.814552e-01_rb,8.819705e-01_rb,8.824611e-01_rb,8.829311e-01_rb,8.833791e-01_rb,&
+       & 8.838078e-01_rb,8.842148e-01_rb,8.846044e-01_rb,8.849756e-01_rb,8.853291e-01_rb,&
+       & 8.856645e-01_rb,8.859841e-01_rb,8.862904e-01_rb,8.865801e-01_rb,8.868551e-01_rb,&
+       & 8.871182e-01_rb,8.873673e-01_rb,8.876059e-01_rb,8.878307e-01_rb,8.880462e-01_rb,&
+       & 8.882501e-01_rb,8.884453e-01_rb,8.886339e-01_rb /)
+!     BAND  21
+      asyliq1(:, 21) = (/ &
+       & 7.838510e-01_rb,7.803151e-01_rb,7.980477e-01_rb,8.144160e-01_rb,8.261784e-01_rb,&
+       & 8.344240e-01_rb,8.404278e-01_rb,8.450391e-01_rb,8.487593e-01_rb,8.518741e-01_rb,&
+       & 8.545484e-01_rb,8.568890e-01_rb,8.589560e-01_rb,8.607983e-01_rb,8.624504e-01_rb,&
+       & 8.639408e-01_rb,8.652945e-01_rb,8.665301e-01_rb,8.676634e-01_rb,8.687121e-01_rb,&
+       & 8.696855e-01_rb,8.705933e-01_rb,8.714448e-01_rb,8.722454e-01_rb,8.730014e-01_rb,&
+       & 8.737180e-01_rb,8.743982e-01_rb,8.750436e-01_rb,8.756598e-01_rb,8.762481e-01_rb,&
+       & 8.768089e-01_rb,8.773427e-01_rb,8.778532e-01_rb,8.783434e-01_rb,8.788089e-01_rb,&
+       & 8.792530e-01_rb,8.796784e-01_rb,8.800845e-01_rb,8.804716e-01_rb,8.808411e-01_rb,&
+       & 8.811923e-01_rb,8.815276e-01_rb,8.818472e-01_rb,8.821504e-01_rb,8.824408e-01_rb,&
+       & 8.827155e-01_rb,8.829777e-01_rb,8.832269e-01_rb,8.834631e-01_rb,8.836892e-01_rb,&
+       & 8.839034e-01_rb,8.841075e-01_rb,8.843021e-01_rb,8.844866e-01_rb,8.846631e-01_rb,&
+       & 8.848304e-01_rb,8.849910e-01_rb,8.851425e-01_rb /)
+!     BAND  22
+      asyliq1(:, 22) = (/ &
+       & 7.760783e-01_rb,7.890215e-01_rb,8.090192e-01_rb,8.230252e-01_rb,8.321369e-01_rb,&
+       & 8.384258e-01_rb,8.431529e-01_rb,8.469558e-01_rb,8.501499e-01_rb,8.528899e-01_rb,&
+       & 8.552899e-01_rb,8.573956e-01_rb,8.592570e-01_rb,8.609098e-01_rb,8.623897e-01_rb,&
+       & 8.637169e-01_rb,8.649184e-01_rb,8.660097e-01_rb,8.670096e-01_rb,8.679338e-01_rb,&
+       & 8.687896e-01_rb,8.695880e-01_rb,8.703365e-01_rb,8.710422e-01_rb,8.717092e-01_rb,&
+       & 8.723378e-01_rb,8.729363e-01_rb,8.735063e-01_rb,8.740475e-01_rb,8.745661e-01_rb,&
+       & 8.750560e-01_rb,8.755275e-01_rb,8.759731e-01_rb,8.764000e-01_rb,8.768071e-01_rb,&
+       & 8.771942e-01_rb,8.775628e-01_rb,8.779126e-01_rb,8.782483e-01_rb,8.785626e-01_rb,&
+       & 8.788610e-01_rb,8.791482e-01_rb,8.794180e-01_rb,8.796765e-01_rb,8.799207e-01_rb,&
+       & 8.801522e-01_rb,8.803707e-01_rb,8.805777e-01_rb,8.807749e-01_rb,8.809605e-01_rb,&
+       & 8.811362e-01_rb,8.813047e-01_rb,8.814647e-01_rb,8.816131e-01_rb,8.817588e-01_rb,&
+       & 8.818930e-01_rb,8.820230e-01_rb,8.821445e-01_rb /)
+!     BAND  23
+      asyliq1(:, 23) = (/ &
+       & 7.847907e-01_rb,8.099917e-01_rb,8.257428e-01_rb,8.350423e-01_rb,8.411971e-01_rb,&
+       & 8.457241e-01_rb,8.493010e-01_rb,8.522565e-01_rb,8.547660e-01_rb,8.569311e-01_rb,&
+       & 8.588181e-01_rb,8.604729e-01_rb,8.619296e-01_rb,8.632208e-01_rb,8.643725e-01_rb,&
+       & 8.654050e-01_rb,8.663363e-01_rb,8.671835e-01_rb,8.679590e-01_rb,8.686707e-01_rb,&
+       & 8.693308e-01_rb,8.699433e-01_rb,8.705147e-01_rb,8.710490e-01_rb,8.715497e-01_rb,&
+       & 8.720219e-01_rb,8.724669e-01_rb,8.728849e-01_rb,8.732806e-01_rb,8.736550e-01_rb,&
+       & 8.740099e-01_rb,8.743435e-01_rb,8.746601e-01_rb,8.749610e-01_rb,8.752449e-01_rb,&
+       & 8.755143e-01_rb,8.757688e-01_rb,8.760095e-01_rb,8.762375e-01_rb,8.764532e-01_rb,&
+       & 8.766579e-01_rb,8.768506e-01_rb,8.770323e-01_rb,8.772049e-01_rb,8.773690e-01_rb,&
+       & 8.775226e-01_rb,8.776679e-01_rb,8.778062e-01_rb,8.779360e-01_rb,8.780587e-01_rb,&
+       & 8.781747e-01_rb,8.782852e-01_rb,8.783892e-01_rb,8.784891e-01_rb,8.785824e-01_rb,&
+       & 8.786705e-01_rb,8.787546e-01_rb,8.788336e-01_rb /)
+!     BAND  24
+      asyliq1(:, 24) = (/ &
+       & 8.054324e-01_rb,8.266282e-01_rb,8.378075e-01_rb,8.449848e-01_rb,8.502166e-01_rb,&
+       & 8.542268e-01_rb,8.573477e-01_rb,8.598022e-01_rb,8.617689e-01_rb,8.633859e-01_rb,&
+       & 8.647536e-01_rb,8.659354e-01_rb,8.669807e-01_rb,8.679143e-01_rb,8.687577e-01_rb,&
+       & 8.695222e-01_rb,8.702207e-01_rb,8.708591e-01_rb,8.714446e-01_rb,8.719836e-01_rb,&
+       & 8.724812e-01_rb,8.729426e-01_rb,8.733689e-01_rb,8.737665e-01_rb,8.741373e-01_rb,&
+       & 8.744834e-01_rb,8.748070e-01_rb,8.751131e-01_rb,8.754011e-01_rb,8.756676e-01_rb,&
+       & 8.759219e-01_rb,8.761599e-01_rb,8.763857e-01_rb,8.765984e-01_rb,8.767999e-01_rb,&
+       & 8.769889e-01_rb,8.771669e-01_rb,8.773373e-01_rb,8.774969e-01_rb,8.776469e-01_rb,&
+       & 8.777894e-01_rb,8.779237e-01_rb,8.780505e-01_rb,8.781703e-01_rb,8.782820e-01_rb,&
+       & 8.783886e-01_rb,8.784894e-01_rb,8.785844e-01_rb,8.786736e-01_rb,8.787584e-01_rb,&
+       & 8.788379e-01_rb,8.789130e-01_rb,8.789849e-01_rb,8.790506e-01_rb,8.791141e-01_rb,&
+       & 8.791750e-01_rb,8.792324e-01_rb,8.792867e-01_rb /)
+!     BAND  25
+      asyliq1(:, 25) = (/ &
+       & 8.249534e-01_rb,8.391988e-01_rb,8.474107e-01_rb,8.526860e-01_rb,8.563983e-01_rb,&
+       & 8.592389e-01_rb,8.615144e-01_rb,8.633790e-01_rb,8.649325e-01_rb,8.662504e-01_rb,&
+       & 8.673841e-01_rb,8.683741e-01_rb,8.692495e-01_rb,8.700309e-01_rb,8.707328e-01_rb,&
+       & 8.713650e-01_rb,8.719432e-01_rb,8.724676e-01_rb,8.729498e-01_rb,8.733922e-01_rb,&
+       & 8.737981e-01_rb,8.741745e-01_rb,8.745225e-01_rb,8.748467e-01_rb,8.751512e-01_rb,&
+       & 8.754315e-01_rb,8.756962e-01_rb,8.759450e-01_rb,8.761774e-01_rb,8.763945e-01_rb,&
+       & 8.766021e-01_rb,8.767970e-01_rb,8.769803e-01_rb,8.771511e-01_rb,8.773151e-01_rb,&
+       & 8.774689e-01_rb,8.776147e-01_rb,8.777533e-01_rb,8.778831e-01_rb,8.780050e-01_rb,&
+       & 8.781197e-01_rb,8.782301e-01_rb,8.783323e-01_rb,8.784312e-01_rb,8.785222e-01_rb,&
+       & 8.786096e-01_rb,8.786916e-01_rb,8.787688e-01_rb,8.788411e-01_rb,8.789122e-01_rb,&
+       & 8.789762e-01_rb,8.790373e-01_rb,8.790954e-01_rb,8.791514e-01_rb,8.792018e-01_rb,&
+       & 8.792517e-01_rb,8.792990e-01_rb,8.793429e-01_rb /)
+!     BAND  26
+      asyliq1(:, 26) = (/ &
+       & 8.323091e-01_rb,8.429776e-01_rb,8.498123e-01_rb,8.546929e-01_rb,8.584295e-01_rb,&
+       & 8.613489e-01_rb,8.636324e-01_rb,8.654303e-01_rb,8.668675e-01_rb,8.680404e-01_rb,&
+       & 8.690174e-01_rb,8.698495e-01_rb,8.705666e-01_rb,8.711961e-01_rb,8.717556e-01_rb,&
+       & 8.722546e-01_rb,8.727063e-01_rb,8.731170e-01_rb,8.734933e-01_rb,8.738382e-01_rb,&
+       & 8.741590e-01_rb,8.744525e-01_rb,8.747295e-01_rb,8.749843e-01_rb,8.752210e-01_rb,&
+       & 8.754437e-01_rb,8.756524e-01_rb,8.758472e-01_rb,8.760288e-01_rb,8.762030e-01_rb,&
+       & 8.763603e-01_rb,8.765122e-01_rb,8.766539e-01_rb,8.767894e-01_rb,8.769130e-01_rb,&
+       & 8.770310e-01_rb,8.771422e-01_rb,8.772437e-01_rb,8.773419e-01_rb,8.774355e-01_rb,&
+       & 8.775221e-01_rb,8.776047e-01_rb,8.776802e-01_rb,8.777539e-01_rb,8.778216e-01_rb,&
+       & 8.778859e-01_rb,8.779473e-01_rb,8.780031e-01_rb,8.780562e-01_rb,8.781097e-01_rb,&
+       & 8.781570e-01_rb,8.782021e-01_rb,8.782463e-01_rb,8.782845e-01_rb,8.783235e-01_rb,&
+       & 8.783610e-01_rb,8.783953e-01_rb,8.784273e-01_rb /)
+!     BAND  27
+      asyliq1(:, 27) = (/ &
+       & 8.396448e-01_rb,8.480172e-01_rb,8.535934e-01_rb,8.574145e-01_rb,8.600835e-01_rb,&
+       & 8.620347e-01_rb,8.635500e-01_rb,8.648003e-01_rb,8.658758e-01_rb,8.668248e-01_rb,&
+       & 8.676697e-01_rb,8.684220e-01_rb,8.690893e-01_rb,8.696807e-01_rb,8.702046e-01_rb,&
+       & 8.706676e-01_rb,8.710798e-01_rb,8.714478e-01_rb,8.717778e-01_rb,8.720747e-01_rb,&
+       & 8.723431e-01_rb,8.725889e-01_rb,8.728144e-01_rb,8.730201e-01_rb,8.732129e-01_rb,&
+       & 8.733907e-01_rb,8.735541e-01_rb,8.737100e-01_rb,8.738533e-01_rb,8.739882e-01_rb,&
+       & 8.741164e-01_rb,8.742362e-01_rb,8.743485e-01_rb,8.744530e-01_rb,8.745512e-01_rb,&
+       & 8.746471e-01_rb,8.747373e-01_rb,8.748186e-01_rb,8.748973e-01_rb,8.749732e-01_rb,&
+       & 8.750443e-01_rb,8.751105e-01_rb,8.751747e-01_rb,8.752344e-01_rb,8.752902e-01_rb,&
+       & 8.753412e-01_rb,8.753917e-01_rb,8.754393e-01_rb,8.754843e-01_rb,8.755282e-01_rb,&
+       & 8.755662e-01_rb,8.756039e-01_rb,8.756408e-01_rb,8.756722e-01_rb,8.757072e-01_rb,&
+       & 8.757352e-01_rb,8.757653e-01_rb,8.757932e-01_rb /)
+!     BAND  28
+      asyliq1(:, 28) = (/ &
+       & 8.374590e-01_rb,8.465669e-01_rb,8.518701e-01_rb,8.547627e-01_rb,8.565745e-01_rb,&
+       & 8.579065e-01_rb,8.589717e-01_rb,8.598632e-01_rb,8.606363e-01_rb,8.613268e-01_rb,&
+       & 8.619560e-01_rb,8.625340e-01_rb,8.630689e-01_rb,8.635601e-01_rb,8.640084e-01_rb,&
+       & 8.644180e-01_rb,8.647885e-01_rb,8.651220e-01_rb,8.654218e-01_rb,8.656908e-01_rb,&
+       & 8.659294e-01_rb,8.661422e-01_rb,8.663334e-01_rb,8.665037e-01_rb,8.666543e-01_rb,&
+       & 8.667913e-01_rb,8.669156e-01_rb,8.670242e-01_rb,8.671249e-01_rb,8.672161e-01_rb,&
+       & 8.672993e-01_rb,8.673733e-01_rb,8.674457e-01_rb,8.675103e-01_rb,8.675713e-01_rb,&
+       & 8.676267e-01_rb,8.676798e-01_rb,8.677286e-01_rb,8.677745e-01_rb,8.678178e-01_rb,&
+       & 8.678601e-01_rb,8.678986e-01_rb,8.679351e-01_rb,8.679693e-01_rb,8.680013e-01_rb,&
+       & 8.680334e-01_rb,8.680624e-01_rb,8.680915e-01_rb,8.681178e-01_rb,8.681428e-01_rb,&
+       & 8.681654e-01_rb,8.681899e-01_rb,8.682103e-01_rb,8.682317e-01_rb,8.682498e-01_rb,&
+       & 8.682677e-01_rb,8.682861e-01_rb,8.683041e-01_rb /)
+!     BAND  29
+      asyliq1(:, 29) = (/ &
+       & 7.877069e-01_rb,8.244281e-01_rb,8.367971e-01_rb,8.409074e-01_rb,8.429859e-01_rb,&
+       & 8.454386e-01_rb,8.489350e-01_rb,8.534141e-01_rb,8.585814e-01_rb,8.641267e-01_rb,&
+       & 8.697999e-01_rb,8.754223e-01_rb,8.808785e-01_rb,8.860944e-01_rb,8.910354e-01_rb,&
+       & 8.956837e-01_rb,9.000392e-01_rb,9.041091e-01_rb,9.079071e-01_rb,9.114479e-01_rb,&
+       & 9.147462e-01_rb,9.178234e-01_rb,9.206903e-01_rb,9.233663e-01_rb,9.258668e-01_rb,&
+       & 9.282006e-01_rb,9.303847e-01_rb,9.324288e-01_rb,9.343418e-01_rb,9.361356e-01_rb,&
+       & 9.378176e-01_rb,9.393939e-01_rb,9.408736e-01_rb,9.422622e-01_rb,9.435670e-01_rb,&
+       & 9.447900e-01_rb,9.459395e-01_rb,9.470199e-01_rb,9.480335e-01_rb,9.489852e-01_rb,&
+       & 9.498782e-01_rb,9.507168e-01_rb,9.515044e-01_rb,9.522470e-01_rb,9.529409e-01_rb,&
+       & 9.535946e-01_rb,9.542071e-01_rb,9.547838e-01_rb,9.553256e-01_rb,9.558351e-01_rb,&
+       & 9.563139e-01_rb,9.567660e-01_rb,9.571915e-01_rb,9.575901e-01_rb,9.579685e-01_rb,&
+       & 9.583239e-01_rb,9.586602e-01_rb,9.589766e-01_rb /)
+
+
+! Spherical Ice Particle Parameterization
+! extinction units (ext coef/iwc): [(m^-1)/(g m^-3)]
+      extice2(:, 16) = (/ &
+! band 16
+        & 4.101824e-01_rb,2.435514e-01_rb,1.713697e-01_rb,1.314865e-01_rb,1.063406e-01_rb,&
+        & 8.910701e-02_rb,7.659480e-02_rb,6.711784e-02_rb,5.970353e-02_rb,5.375249e-02_rb,&
+        & 4.887577e-02_rb,4.481025e-02_rb,4.137171e-02_rb,3.842744e-02_rb,3.587948e-02_rb,&
+        & 3.365396e-02_rb,3.169419e-02_rb,2.995593e-02_rb,2.840419e-02_rb,2.701091e-02_rb,&
+        & 2.575336e-02_rb,2.461293e-02_rb,2.357423e-02_rb,2.262443e-02_rb,2.175276e-02_rb,&
+        & 2.095012e-02_rb,2.020875e-02_rb,1.952199e-02_rb,1.888412e-02_rb,1.829018e-02_rb,&
+        & 1.773586e-02_rb,1.721738e-02_rb,1.673144e-02_rb,1.627510e-02_rb,1.584579e-02_rb,&
+        & 1.544122e-02_rb,1.505934e-02_rb,1.469833e-02_rb,1.435654e-02_rb,1.403251e-02_rb,&
+        & 1.372492e-02_rb,1.343255e-02_rb,1.315433e-02_rb /)
+      extice2(:, 17) = (/ &
+! band 17
+        & 3.836650e-01_rb,2.304055e-01_rb,1.637265e-01_rb,1.266681e-01_rb,1.031602e-01_rb,&
+        & 8.695191e-02_rb,7.511544e-02_rb,6.610009e-02_rb,5.900909e-02_rb,5.328833e-02_rb,&
+        & 4.857728e-02_rb,4.463133e-02_rb,4.127880e-02_rb,3.839567e-02_rb,3.589013e-02_rb,&
+        & 3.369280e-02_rb,3.175027e-02_rb,3.002079e-02_rb,2.847121e-02_rb,2.707493e-02_rb,&
+        & 2.581031e-02_rb,2.465962e-02_rb,2.360815e-02_rb,2.264363e-02_rb,2.175571e-02_rb,&
+        & 2.093563e-02_rb,2.017592e-02_rb,1.947015e-02_rb,1.881278e-02_rb,1.819901e-02_rb,&
+        & 1.762463e-02_rb,1.708598e-02_rb,1.657982e-02_rb,1.610330e-02_rb,1.565390e-02_rb,&
+        & 1.522937e-02_rb,1.482768e-02_rb,1.444706e-02_rb,1.408588e-02_rb,1.374270e-02_rb,&
+        & 1.341619e-02_rb,1.310517e-02_rb,1.280857e-02_rb /)
+      extice2(:, 18) = (/ &
+! band 18
+        & 4.152673e-01_rb,2.436816e-01_rb,1.702243e-01_rb,1.299704e-01_rb,1.047528e-01_rb,&
+        & 8.756039e-02_rb,7.513327e-02_rb,6.575690e-02_rb,5.844616e-02_rb,5.259609e-02_rb,&
+        & 4.781531e-02_rb,4.383980e-02_rb,4.048517e-02_rb,3.761891e-02_rb,3.514342e-02_rb,&
+        & 3.298525e-02_rb,3.108814e-02_rb,2.940825e-02_rb,2.791096e-02_rb,2.656858e-02_rb,&
+        & 2.535869e-02_rb,2.426297e-02_rb,2.326627e-02_rb,2.235602e-02_rb,2.152164e-02_rb,&
+        & 2.075420e-02_rb,2.004613e-02_rb,1.939091e-02_rb,1.878296e-02_rb,1.821744e-02_rb,&
+        & 1.769015e-02_rb,1.719741e-02_rb,1.673600e-02_rb,1.630308e-02_rb,1.589615e-02_rb,&
+        & 1.551298e-02_rb,1.515159e-02_rb,1.481021e-02_rb,1.448726e-02_rb,1.418131e-02_rb,&
+        & 1.389109e-02_rb,1.361544e-02_rb,1.335330e-02_rb /)
+      extice2(:, 19) = (/ &
+! band 19
+        & 3.873250e-01_rb,2.331609e-01_rb,1.655002e-01_rb,1.277753e-01_rb,1.038247e-01_rb,&
+        & 8.731780e-02_rb,7.527638e-02_rb,6.611873e-02_rb,5.892850e-02_rb,5.313885e-02_rb,&
+        & 4.838068e-02_rb,4.440356e-02_rb,4.103167e-02_rb,3.813804e-02_rb,3.562870e-02_rb,&
+        & 3.343269e-02_rb,3.149539e-02_rb,2.977414e-02_rb,2.823510e-02_rb,2.685112e-02_rb,&
+        & 2.560015e-02_rb,2.446411e-02_rb,2.342805e-02_rb,2.247948e-02_rb,2.160789e-02_rb,&
+        & 2.080438e-02_rb,2.006139e-02_rb,1.937238e-02_rb,1.873177e-02_rb,1.813469e-02_rb,&
+        & 1.757689e-02_rb,1.705468e-02_rb,1.656479e-02_rb,1.610435e-02_rb,1.567081e-02_rb,&
+        & 1.526192e-02_rb,1.487565e-02_rb,1.451020e-02_rb,1.416396e-02_rb,1.383546e-02_rb,&
+        & 1.352339e-02_rb,1.322657e-02_rb,1.294392e-02_rb /)
+      extice2(:, 20) = (/ &
+! band 20
+        & 3.784280e-01_rb,2.291396e-01_rb,1.632551e-01_rb,1.263775e-01_rb,1.028944e-01_rb,&
+        & 8.666975e-02_rb,7.480952e-02_rb,6.577335e-02_rb,5.866714e-02_rb,5.293694e-02_rb,&
+        & 4.822153e-02_rb,4.427547e-02_rb,4.092626e-02_rb,3.804918e-02_rb,3.555184e-02_rb,&
+        & 3.336440e-02_rb,3.143307e-02_rb,2.971577e-02_rb,2.817912e-02_rb,2.679632e-02_rb,&
+        & 2.554558e-02_rb,2.440903e-02_rb,2.337187e-02_rb,2.242173e-02_rb,2.154821e-02_rb,&
+        & 2.074249e-02_rb,1.999706e-02_rb,1.930546e-02_rb,1.866212e-02_rb,1.806221e-02_rb,&
+        & 1.750152e-02_rb,1.697637e-02_rb,1.648352e-02_rb,1.602010e-02_rb,1.558358e-02_rb,&
+        & 1.517172e-02_rb,1.478250e-02_rb,1.441413e-02_rb,1.406498e-02_rb,1.373362e-02_rb,&
+        & 1.341872e-02_rb,1.311911e-02_rb,1.283371e-02_rb /)
+      extice2(:, 21) = (/ &
+! band 21
+        & 3.719909e-01_rb,2.259490e-01_rb,1.613144e-01_rb,1.250648e-01_rb,1.019462e-01_rb,&
+        & 8.595358e-02_rb,7.425064e-02_rb,6.532618e-02_rb,5.830218e-02_rb,5.263421e-02_rb,&
+        & 4.796697e-02_rb,4.405891e-02_rb,4.074013e-02_rb,3.788776e-02_rb,3.541071e-02_rb,&
+        & 3.324008e-02_rb,3.132280e-02_rb,2.961733e-02_rb,2.809071e-02_rb,2.671645e-02_rb,&
+        & 2.547302e-02_rb,2.434276e-02_rb,2.331102e-02_rb,2.236558e-02_rb,2.149614e-02_rb,&
+        & 2.069397e-02_rb,1.995163e-02_rb,1.926272e-02_rb,1.862174e-02_rb,1.802389e-02_rb,&
+        & 1.746500e-02_rb,1.694142e-02_rb,1.644994e-02_rb,1.598772e-02_rb,1.555225e-02_rb,&
+        & 1.514129e-02_rb,1.475286e-02_rb,1.438515e-02_rb,1.403659e-02_rb,1.370572e-02_rb,&
+        & 1.339124e-02_rb,1.309197e-02_rb,1.280685e-02_rb /)
+      extice2(:, 22) = (/ &
+! band 22
+        & 3.713158e-01_rb,2.253816e-01_rb,1.608461e-01_rb,1.246718e-01_rb,1.016109e-01_rb,&
+        & 8.566332e-02_rb,7.399666e-02_rb,6.510199e-02_rb,5.810290e-02_rb,5.245608e-02_rb,&
+        & 4.780702e-02_rb,4.391478e-02_rb,4.060989e-02_rb,3.776982e-02_rb,3.530374e-02_rb,&
+        & 3.314296e-02_rb,3.123458e-02_rb,2.953719e-02_rb,2.801794e-02_rb,2.665043e-02_rb,&
+        & 2.541321e-02_rb,2.428868e-02_rb,2.326224e-02_rb,2.232173e-02_rb,2.145688e-02_rb,&
+        & 2.065899e-02_rb,1.992067e-02_rb,1.923552e-02_rb,1.859808e-02_rb,1.800356e-02_rb,&
+        & 1.744782e-02_rb,1.692721e-02_rb,1.643855e-02_rb,1.597900e-02_rb,1.554606e-02_rb,&
+        & 1.513751e-02_rb,1.475137e-02_rb,1.438586e-02_rb,1.403938e-02_rb,1.371050e-02_rb,&
+        & 1.339793e-02_rb,1.310050e-02_rb,1.281713e-02_rb /)
+      extice2(:, 23) = (/ &
+! band 23
+        & 3.605883e-01_rb,2.204388e-01_rb,1.580431e-01_rb,1.229033e-01_rb,1.004203e-01_rb,&
+        & 8.482616e-02_rb,7.338941e-02_rb,6.465105e-02_rb,5.776176e-02_rb,5.219398e-02_rb,&
+        & 4.760288e-02_rb,4.375369e-02_rb,4.048111e-02_rb,3.766539e-02_rb,3.521771e-02_rb,&
+        & 3.307079e-02_rb,3.117277e-02_rb,2.948303e-02_rb,2.796929e-02_rb,2.660560e-02_rb,&
+        & 2.537086e-02_rb,2.424772e-02_rb,2.322182e-02_rb,2.228114e-02_rb,2.141556e-02_rb,&
+        & 2.061649e-02_rb,1.987661e-02_rb,1.918962e-02_rb,1.855009e-02_rb,1.795330e-02_rb,&
+        & 1.739514e-02_rb,1.687199e-02_rb,1.638069e-02_rb,1.591845e-02_rb,1.548276e-02_rb,&
+        & 1.507143e-02_rb,1.468249e-02_rb,1.431416e-02_rb,1.396486e-02_rb,1.363318e-02_rb,&
+        & 1.331781e-02_rb,1.301759e-02_rb,1.273147e-02_rb /)
+      extice2(:, 24) = (/ &
+! band 24
+        & 3.527890e-01_rb,2.168469e-01_rb,1.560090e-01_rb,1.216216e-01_rb,9.955787e-02_rb,&
+        & 8.421942e-02_rb,7.294827e-02_rb,6.432192e-02_rb,5.751081e-02_rb,5.199888e-02_rb,&
+        & 4.744835e-02_rb,4.362899e-02_rb,4.037847e-02_rb,3.757910e-02_rb,3.514351e-02_rb,&
+        & 3.300546e-02_rb,3.111382e-02_rb,2.942853e-02_rb,2.791775e-02_rb,2.655584e-02_rb,&
+        & 2.532195e-02_rb,2.419892e-02_rb,2.317255e-02_rb,2.223092e-02_rb,2.136402e-02_rb,&
+        & 2.056334e-02_rb,1.982160e-02_rb,1.913258e-02_rb,1.849087e-02_rb,1.789178e-02_rb,&
+        & 1.733124e-02_rb,1.680565e-02_rb,1.631187e-02_rb,1.584711e-02_rb,1.540889e-02_rb,&
+        & 1.499502e-02_rb,1.460354e-02_rb,1.423269e-02_rb,1.388088e-02_rb,1.354670e-02_rb,&
+        & 1.322887e-02_rb,1.292620e-02_rb,1.263767e-02_rb /)
+      extice2(:, 25) = (/ &
+! band 25
+        & 3.477874e-01_rb,2.143515e-01_rb,1.544887e-01_rb,1.205942e-01_rb,9.881779e-02_rb,&
+        & 8.366261e-02_rb,7.251586e-02_rb,6.397790e-02_rb,5.723183e-02_rb,5.176908e-02_rb,&
+        & 4.725658e-02_rb,4.346715e-02_rb,4.024055e-02_rb,3.746055e-02_rb,3.504080e-02_rb,&
+        & 3.291583e-02_rb,3.103507e-02_rb,2.935891e-02_rb,2.785582e-02_rb,2.650042e-02_rb,&
+        & 2.527206e-02_rb,2.415376e-02_rb,2.313142e-02_rb,2.219326e-02_rb,2.132934e-02_rb,&
+        & 2.053122e-02_rb,1.979169e-02_rb,1.910456e-02_rb,1.846448e-02_rb,1.786680e-02_rb,&
+        & 1.730745e-02_rb,1.678289e-02_rb,1.628998e-02_rb,1.582595e-02_rb,1.538835e-02_rb,&
+        & 1.497499e-02_rb,1.458393e-02_rb,1.421341e-02_rb,1.386187e-02_rb,1.352788e-02_rb,&
+        & 1.321019e-02_rb,1.290762e-02_rb,1.261913e-02_rb /)
+      extice2(:, 26) = (/ &
+! band 26
+        & 3.453721e-01_rb,2.130744e-01_rb,1.536698e-01_rb,1.200140e-01_rb,9.838078e-02_rb,&
+        & 8.331940e-02_rb,7.223803e-02_rb,6.374775e-02_rb,5.703770e-02_rb,5.160290e-02_rb,&
+        & 4.711259e-02_rb,4.334110e-02_rb,4.012923e-02_rb,3.736150e-02_rb,3.495208e-02_rb,&
+        & 3.283589e-02_rb,3.096267e-02_rb,2.929302e-02_rb,2.779560e-02_rb,2.644517e-02_rb,&
+        & 2.522119e-02_rb,2.410677e-02_rb,2.308788e-02_rb,2.215281e-02_rb,2.129165e-02_rb,&
+        & 2.049602e-02_rb,1.975874e-02_rb,1.907365e-02_rb,1.843542e-02_rb,1.783943e-02_rb,&
+        & 1.728162e-02_rb,1.675847e-02_rb,1.626685e-02_rb,1.580401e-02_rb,1.536750e-02_rb,&
+        & 1.495515e-02_rb,1.456502e-02_rb,1.419537e-02_rb,1.384463e-02_rb,1.351139e-02_rb,&
+        & 1.319438e-02_rb,1.289246e-02_rb,1.260456e-02_rb /)
+      extice2(:, 27) = (/ &
+! band 27
+        & 3.417883e-01_rb,2.113379e-01_rb,1.526395e-01_rb,1.193347e-01_rb,9.790253e-02_rb,&
+        & 8.296715e-02_rb,7.196979e-02_rb,6.353806e-02_rb,5.687024e-02_rb,5.146670e-02_rb,&
+        & 4.700001e-02_rb,4.324667e-02_rb,4.004894e-02_rb,3.729233e-02_rb,3.489172e-02_rb,&
+        & 3.278257e-02_rb,3.091499e-02_rb,2.924987e-02_rb,2.775609e-02_rb,2.640859e-02_rb,&
+        & 2.518695e-02_rb,2.407439e-02_rb,2.305697e-02_rb,2.212303e-02_rb,2.126273e-02_rb,&
+        & 2.046774e-02_rb,1.973090e-02_rb,1.904610e-02_rb,1.840801e-02_rb,1.781204e-02_rb,&
+        & 1.725417e-02_rb,1.673086e-02_rb,1.623902e-02_rb,1.577590e-02_rb,1.533906e-02_rb,&
+        & 1.492634e-02_rb,1.453580e-02_rb,1.416571e-02_rb,1.381450e-02_rb,1.348078e-02_rb,&
+        & 1.316327e-02_rb,1.286082e-02_rb,1.257240e-02_rb /)
+      extice2(:, 28) = (/ &
+! band 28
+        & 3.416111e-01_rb,2.114124e-01_rb,1.527734e-01_rb,1.194809e-01_rb,9.804612e-02_rb,&
+        & 8.310287e-02_rb,7.209595e-02_rb,6.365442e-02_rb,5.697710e-02_rb,5.156460e-02_rb,&
+        & 4.708957e-02_rb,4.332850e-02_rb,4.012361e-02_rb,3.736037e-02_rb,3.495364e-02_rb,&
+        & 3.283879e-02_rb,3.096593e-02_rb,2.929589e-02_rb,2.779751e-02_rb,2.644571e-02_rb,&
+        & 2.522004e-02_rb,2.410369e-02_rb,2.308271e-02_rb,2.214542e-02_rb,2.128195e-02_rb,&
+        & 2.048396e-02_rb,1.974429e-02_rb,1.905679e-02_rb,1.841614e-02_rb,1.781774e-02_rb,&
+        & 1.725754e-02_rb,1.673203e-02_rb,1.623807e-02_rb,1.577293e-02_rb,1.533416e-02_rb,&
+        & 1.491958e-02_rb,1.452727e-02_rb,1.415547e-02_rb,1.380262e-02_rb,1.346732e-02_rb,&
+        & 1.314830e-02_rb,1.284439e-02_rb,1.255456e-02_rb /)
+      extice2(:, 29) = (/ &
+! band 29
+        & 4.196611e-01_rb,2.493642e-01_rb,1.761261e-01_rb,1.357197e-01_rb,1.102161e-01_rb,&
+        & 9.269376e-02_rb,7.992985e-02_rb,7.022538e-02_rb,6.260168e-02_rb,5.645603e-02_rb,&
+        & 5.139732e-02_rb,4.716088e-02_rb,4.356133e-02_rb,4.046498e-02_rb,3.777303e-02_rb,&
+        & 3.541094e-02_rb,3.332137e-02_rb,3.145954e-02_rb,2.978998e-02_rb,2.828419e-02_rb,&
+        & 2.691905e-02_rb,2.567559e-02_rb,2.453811e-02_rb,2.349350e-02_rb,2.253072e-02_rb,&
+        & 2.164042e-02_rb,2.081464e-02_rb,2.004652e-02_rb,1.933015e-02_rb,1.866041e-02_rb,&
+        & 1.803283e-02_rb,1.744348e-02_rb,1.688894e-02_rb,1.636616e-02_rb,1.587244e-02_rb,&
+        & 1.540539e-02_rb,1.496287e-02_rb,1.454295e-02_rb,1.414392e-02_rb,1.376423e-02_rb,&
+        & 1.340247e-02_rb,1.305739e-02_rb,1.272784e-02_rb /)
+
+! single-scattering albedo: unitless
+      ssaice2(:, 16) = (/ &
+! band 16
+        & 6.630615e-01_rb,6.451169e-01_rb,6.333696e-01_rb,6.246927e-01_rb,6.178420e-01_rb,&
+        & 6.121976e-01_rb,6.074069e-01_rb,6.032505e-01_rb,5.995830e-01_rb,5.963030e-01_rb,&
+        & 5.933372e-01_rb,5.906311e-01_rb,5.881427e-01_rb,5.858395e-01_rb,5.836955e-01_rb,&
+        & 5.816896e-01_rb,5.798046e-01_rb,5.780264e-01_rb,5.763429e-01_rb,5.747441e-01_rb,&
+        & 5.732213e-01_rb,5.717672e-01_rb,5.703754e-01_rb,5.690403e-01_rb,5.677571e-01_rb,&
+        & 5.665215e-01_rb,5.653297e-01_rb,5.641782e-01_rb,5.630643e-01_rb,5.619850e-01_rb,&
+        & 5.609381e-01_rb,5.599214e-01_rb,5.589328e-01_rb,5.579707e-01_rb,5.570333e-01_rb,&
+        & 5.561193e-01_rb,5.552272e-01_rb,5.543558e-01_rb,5.535041e-01_rb,5.526708e-01_rb,&
+        & 5.518551e-01_rb,5.510561e-01_rb,5.502729e-01_rb /)
+      ssaice2(:, 17) = (/ &
+! band 17
+        & 7.689749e-01_rb,7.398171e-01_rb,7.205819e-01_rb,7.065690e-01_rb,6.956928e-01_rb,&
+        & 6.868989e-01_rb,6.795813e-01_rb,6.733606e-01_rb,6.679838e-01_rb,6.632742e-01_rb,&
+        & 6.591036e-01_rb,6.553766e-01_rb,6.520197e-01_rb,6.489757e-01_rb,6.461991e-01_rb,&
+        & 6.436531e-01_rb,6.413075e-01_rb,6.391375e-01_rb,6.371221e-01_rb,6.352438e-01_rb,&
+        & 6.334876e-01_rb,6.318406e-01_rb,6.302918e-01_rb,6.288315e-01_rb,6.274512e-01_rb,&
+        & 6.261436e-01_rb,6.249022e-01_rb,6.237211e-01_rb,6.225953e-01_rb,6.215201e-01_rb,&
+        & 6.204914e-01_rb,6.195055e-01_rb,6.185592e-01_rb,6.176492e-01_rb,6.167730e-01_rb,&
+        & 6.159280e-01_rb,6.151120e-01_rb,6.143228e-01_rb,6.135587e-01_rb,6.128177e-01_rb,&
+        & 6.120984e-01_rb,6.113993e-01_rb,6.107189e-01_rb /)
+      ssaice2(:, 18) = (/ &
+! band 18
+        & 9.956167e-01_rb,9.814770e-01_rb,9.716104e-01_rb,9.639746e-01_rb,9.577179e-01_rb,&
+        & 9.524010e-01_rb,9.477672e-01_rb,9.436527e-01_rb,9.399467e-01_rb,9.365708e-01_rb,&
+        & 9.334672e-01_rb,9.305921e-01_rb,9.279118e-01_rb,9.253993e-01_rb,9.230330e-01_rb,&
+        & 9.207954e-01_rb,9.186719e-01_rb,9.166501e-01_rb,9.147199e-01_rb,9.128722e-01_rb,&
+        & 9.110997e-01_rb,9.093956e-01_rb,9.077544e-01_rb,9.061708e-01_rb,9.046406e-01_rb,&
+        & 9.031598e-01_rb,9.017248e-01_rb,9.003326e-01_rb,8.989804e-01_rb,8.976655e-01_rb,&
+        & 8.963857e-01_rb,8.951389e-01_rb,8.939233e-01_rb,8.927370e-01_rb,8.915785e-01_rb,&
+        & 8.904464e-01_rb,8.893392e-01_rb,8.882559e-01_rb,8.871951e-01_rb,8.861559e-01_rb,&
+        & 8.851373e-01_rb,8.841383e-01_rb,8.831581e-01_rb /)
+      ssaice2(:, 19) = (/ &
+! band 19
+        & 9.723177e-01_rb,9.452119e-01_rb,9.267592e-01_rb,9.127393e-01_rb,9.014238e-01_rb,&
+        & 8.919334e-01_rb,8.837584e-01_rb,8.765773e-01_rb,8.701736e-01_rb,8.643950e-01_rb,&
+        & 8.591299e-01_rb,8.542942e-01_rb,8.498230e-01_rb,8.456651e-01_rb,8.417794e-01_rb,&
+        & 8.381324e-01_rb,8.346964e-01_rb,8.314484e-01_rb,8.283687e-01_rb,8.254408e-01_rb,&
+        & 8.226505e-01_rb,8.199854e-01_rb,8.174348e-01_rb,8.149891e-01_rb,8.126403e-01_rb,&
+        & 8.103808e-01_rb,8.082041e-01_rb,8.061044e-01_rb,8.040765e-01_rb,8.021156e-01_rb,&
+        & 8.002174e-01_rb,7.983781e-01_rb,7.965941e-01_rb,7.948622e-01_rb,7.931795e-01_rb,&
+        & 7.915432e-01_rb,7.899508e-01_rb,7.884002e-01_rb,7.868891e-01_rb,7.854156e-01_rb,&
+        & 7.839779e-01_rb,7.825742e-01_rb,7.812031e-01_rb /)
+      ssaice2(:, 20) = (/ &
+! band 20
+        & 9.933294e-01_rb,9.860917e-01_rb,9.811564e-01_rb,9.774008e-01_rb,9.743652e-01_rb,&
+        & 9.718155e-01_rb,9.696159e-01_rb,9.676810e-01_rb,9.659531e-01_rb,9.643915e-01_rb,&
+        & 9.629667e-01_rb,9.616561e-01_rb,9.604426e-01_rb,9.593125e-01_rb,9.582548e-01_rb,&
+        & 9.572607e-01_rb,9.563227e-01_rb,9.554347e-01_rb,9.545915e-01_rb,9.537888e-01_rb,&
+        & 9.530226e-01_rb,9.522898e-01_rb,9.515874e-01_rb,9.509130e-01_rb,9.502643e-01_rb,&
+        & 9.496394e-01_rb,9.490366e-01_rb,9.484542e-01_rb,9.478910e-01_rb,9.473456e-01_rb,&
+        & 9.468169e-01_rb,9.463039e-01_rb,9.458056e-01_rb,9.453212e-01_rb,9.448499e-01_rb,&
+        & 9.443910e-01_rb,9.439438e-01_rb,9.435077e-01_rb,9.430821e-01_rb,9.426666e-01_rb,&
+        & 9.422607e-01_rb,9.418638e-01_rb,9.414756e-01_rb /)
+      ssaice2(:, 21) = (/ &
+! band 21
+        & 9.900787e-01_rb,9.828880e-01_rb,9.779258e-01_rb,9.741173e-01_rb,9.710184e-01_rb,&
+        & 9.684012e-01_rb,9.661332e-01_rb,9.641301e-01_rb,9.623352e-01_rb,9.607083e-01_rb,&
+        & 9.592198e-01_rb,9.578474e-01_rb,9.565739e-01_rb,9.553856e-01_rb,9.542715e-01_rb,&
+        & 9.532226e-01_rb,9.522314e-01_rb,9.512919e-01_rb,9.503986e-01_rb,9.495472e-01_rb,&
+        & 9.487337e-01_rb,9.479549e-01_rb,9.472077e-01_rb,9.464897e-01_rb,9.457985e-01_rb,&
+        & 9.451322e-01_rb,9.444890e-01_rb,9.438673e-01_rb,9.432656e-01_rb,9.426826e-01_rb,&
+        & 9.421173e-01_rb,9.415684e-01_rb,9.410351e-01_rb,9.405164e-01_rb,9.400115e-01_rb,&
+        & 9.395198e-01_rb,9.390404e-01_rb,9.385728e-01_rb,9.381164e-01_rb,9.376707e-01_rb,&
+        & 9.372350e-01_rb,9.368091e-01_rb,9.363923e-01_rb /)
+      ssaice2(:, 22) = (/ &
+! band 22
+        & 9.986793e-01_rb,9.985239e-01_rb,9.983911e-01_rb,9.982715e-01_rb,9.981606e-01_rb,&
+        & 9.980562e-01_rb,9.979567e-01_rb,9.978613e-01_rb,9.977691e-01_rb,9.976798e-01_rb,&
+        & 9.975929e-01_rb,9.975081e-01_rb,9.974251e-01_rb,9.973438e-01_rb,9.972640e-01_rb,&
+        & 9.971855e-01_rb,9.971083e-01_rb,9.970322e-01_rb,9.969571e-01_rb,9.968830e-01_rb,&
+        & 9.968099e-01_rb,9.967375e-01_rb,9.966660e-01_rb,9.965951e-01_rb,9.965250e-01_rb,&
+        & 9.964555e-01_rb,9.963867e-01_rb,9.963185e-01_rb,9.962508e-01_rb,9.961836e-01_rb,&
+        & 9.961170e-01_rb,9.960508e-01_rb,9.959851e-01_rb,9.959198e-01_rb,9.958550e-01_rb,&
+        & 9.957906e-01_rb,9.957266e-01_rb,9.956629e-01_rb,9.955997e-01_rb,9.955367e-01_rb,&
+        & 9.954742e-01_rb,9.954119e-01_rb,9.953500e-01_rb /)
+      ssaice2(:, 23) = (/ &
+! band 23
+        & 9.997944e-01_rb,9.997791e-01_rb,9.997664e-01_rb,9.997547e-01_rb,9.997436e-01_rb,&
+        & 9.997327e-01_rb,9.997219e-01_rb,9.997110e-01_rb,9.996999e-01_rb,9.996886e-01_rb,&
+        & 9.996771e-01_rb,9.996653e-01_rb,9.996533e-01_rb,9.996409e-01_rb,9.996282e-01_rb,&
+        & 9.996152e-01_rb,9.996019e-01_rb,9.995883e-01_rb,9.995743e-01_rb,9.995599e-01_rb,&
+        & 9.995453e-01_rb,9.995302e-01_rb,9.995149e-01_rb,9.994992e-01_rb,9.994831e-01_rb,&
+        & 9.994667e-01_rb,9.994500e-01_rb,9.994329e-01_rb,9.994154e-01_rb,9.993976e-01_rb,&
+        & 9.993795e-01_rb,9.993610e-01_rb,9.993422e-01_rb,9.993230e-01_rb,9.993035e-01_rb,&
+        & 9.992837e-01_rb,9.992635e-01_rb,9.992429e-01_rb,9.992221e-01_rb,9.992008e-01_rb,&
+        & 9.991793e-01_rb,9.991574e-01_rb,9.991352e-01_rb /)
+      ssaice2(:, 24) = (/ &
+! band 24
+        & 9.999949e-01_rb,9.999947e-01_rb,9.999943e-01_rb,9.999939e-01_rb,9.999934e-01_rb,&
+        & 9.999927e-01_rb,9.999920e-01_rb,9.999913e-01_rb,9.999904e-01_rb,9.999895e-01_rb,&
+        & 9.999885e-01_rb,9.999874e-01_rb,9.999863e-01_rb,9.999851e-01_rb,9.999838e-01_rb,&
+        & 9.999824e-01_rb,9.999810e-01_rb,9.999795e-01_rb,9.999780e-01_rb,9.999764e-01_rb,&
+        & 9.999747e-01_rb,9.999729e-01_rb,9.999711e-01_rb,9.999692e-01_rb,9.999673e-01_rb,&
+        & 9.999653e-01_rb,9.999632e-01_rb,9.999611e-01_rb,9.999589e-01_rb,9.999566e-01_rb,&
+        & 9.999543e-01_rb,9.999519e-01_rb,9.999495e-01_rb,9.999470e-01_rb,9.999444e-01_rb,&
+        & 9.999418e-01_rb,9.999392e-01_rb,9.999364e-01_rb,9.999336e-01_rb,9.999308e-01_rb,&
+        & 9.999279e-01_rb,9.999249e-01_rb,9.999219e-01_rb /)
+      ssaice2(:, 25) = (/ &
+! band 25
+        & 9.999997e-01_rb,9.999997e-01_rb,9.999997e-01_rb,9.999996e-01_rb,9.999996e-01_rb,&
+        & 9.999995e-01_rb,9.999994e-01_rb,9.999993e-01_rb,9.999993e-01_rb,9.999992e-01_rb,&
+        & 9.999991e-01_rb,9.999989e-01_rb,9.999988e-01_rb,9.999987e-01_rb,9.999986e-01_rb,&
+        & 9.999984e-01_rb,9.999983e-01_rb,9.999981e-01_rb,9.999980e-01_rb,9.999978e-01_rb,&
+        & 9.999976e-01_rb,9.999974e-01_rb,9.999972e-01_rb,9.999971e-01_rb,9.999969e-01_rb,&
+        & 9.999966e-01_rb,9.999964e-01_rb,9.999962e-01_rb,9.999960e-01_rb,9.999957e-01_rb,&
+        & 9.999955e-01_rb,9.999953e-01_rb,9.999950e-01_rb,9.999947e-01_rb,9.999945e-01_rb,&
+        & 9.999942e-01_rb,9.999939e-01_rb,9.999936e-01_rb,9.999934e-01_rb,9.999931e-01_rb,&
+        & 9.999928e-01_rb,9.999925e-01_rb,9.999921e-01_rb /)
+      ssaice2(:, 26) = (/ &
+! band 26
+        & 9.999997e-01_rb,9.999996e-01_rb,9.999996e-01_rb,9.999995e-01_rb,9.999994e-01_rb,&
+        & 9.999993e-01_rb,9.999992e-01_rb,9.999991e-01_rb,9.999990e-01_rb,9.999989e-01_rb,&
+        & 9.999987e-01_rb,9.999986e-01_rb,9.999984e-01_rb,9.999982e-01_rb,9.999980e-01_rb,&
+        & 9.999978e-01_rb,9.999976e-01_rb,9.999974e-01_rb,9.999972e-01_rb,9.999970e-01_rb,&
+        & 9.999967e-01_rb,9.999965e-01_rb,9.999962e-01_rb,9.999959e-01_rb,9.999956e-01_rb,&
+        & 9.999954e-01_rb,9.999951e-01_rb,9.999947e-01_rb,9.999944e-01_rb,9.999941e-01_rb,&
+        & 9.999938e-01_rb,9.999934e-01_rb,9.999931e-01_rb,9.999927e-01_rb,9.999923e-01_rb,&
+        & 9.999920e-01_rb,9.999916e-01_rb,9.999912e-01_rb,9.999908e-01_rb,9.999904e-01_rb,&
+        & 9.999899e-01_rb,9.999895e-01_rb,9.999891e-01_rb /)
+      ssaice2(:, 27) = (/ &
+! band 27
+        & 9.999987e-01_rb,9.999987e-01_rb,9.999985e-01_rb,9.999984e-01_rb,9.999982e-01_rb,&
+        & 9.999980e-01_rb,9.999978e-01_rb,9.999976e-01_rb,9.999973e-01_rb,9.999970e-01_rb,&
+        & 9.999967e-01_rb,9.999964e-01_rb,9.999960e-01_rb,9.999956e-01_rb,9.999952e-01_rb,&
+        & 9.999948e-01_rb,9.999944e-01_rb,9.999939e-01_rb,9.999934e-01_rb,9.999929e-01_rb,&
+        & 9.999924e-01_rb,9.999918e-01_rb,9.999913e-01_rb,9.999907e-01_rb,9.999901e-01_rb,&
+        & 9.999894e-01_rb,9.999888e-01_rb,9.999881e-01_rb,9.999874e-01_rb,9.999867e-01_rb,&
+        & 9.999860e-01_rb,9.999853e-01_rb,9.999845e-01_rb,9.999837e-01_rb,9.999829e-01_rb,&
+        & 9.999821e-01_rb,9.999813e-01_rb,9.999804e-01_rb,9.999796e-01_rb,9.999787e-01_rb,&
+        & 9.999778e-01_rb,9.999768e-01_rb,9.999759e-01_rb /)
+      ssaice2(:, 28) = (/ &
+! band 28
+        & 9.999989e-01_rb,9.999989e-01_rb,9.999987e-01_rb,9.999986e-01_rb,9.999984e-01_rb,&
+        & 9.999982e-01_rb,9.999980e-01_rb,9.999978e-01_rb,9.999975e-01_rb,9.999972e-01_rb,&
+        & 9.999969e-01_rb,9.999966e-01_rb,9.999962e-01_rb,9.999958e-01_rb,9.999954e-01_rb,&
+        & 9.999950e-01_rb,9.999945e-01_rb,9.999941e-01_rb,9.999936e-01_rb,9.999931e-01_rb,&
+        & 9.999925e-01_rb,9.999920e-01_rb,9.999914e-01_rb,9.999908e-01_rb,9.999902e-01_rb,&
+        & 9.999896e-01_rb,9.999889e-01_rb,9.999883e-01_rb,9.999876e-01_rb,9.999869e-01_rb,&
+        & 9.999861e-01_rb,9.999854e-01_rb,9.999846e-01_rb,9.999838e-01_rb,9.999830e-01_rb,&
+        & 9.999822e-01_rb,9.999814e-01_rb,9.999805e-01_rb,9.999796e-01_rb,9.999787e-01_rb,&
+        & 9.999778e-01_rb,9.999769e-01_rb,9.999759e-01_rb /)
+      ssaice2(:, 29) = (/ &
+! band 29
+        & 7.042143e-01_rb,6.691161e-01_rb,6.463240e-01_rb,6.296590e-01_rb,6.166381e-01_rb,&
+        & 6.060183e-01_rb,5.970908e-01_rb,5.894144e-01_rb,5.826968e-01_rb,5.767343e-01_rb,&
+        & 5.713804e-01_rb,5.665256e-01_rb,5.620867e-01_rb,5.579987e-01_rb,5.542101e-01_rb,&
+        & 5.506794e-01_rb,5.473727e-01_rb,5.442620e-01_rb,5.413239e-01_rb,5.385389e-01_rb,&
+        & 5.358901e-01_rb,5.333633e-01_rb,5.309460e-01_rb,5.286277e-01_rb,5.263988e-01_rb,&
+        & 5.242512e-01_rb,5.221777e-01_rb,5.201719e-01_rb,5.182280e-01_rb,5.163410e-01_rb,&
+        & 5.145062e-01_rb,5.127197e-01_rb,5.109776e-01_rb,5.092766e-01_rb,5.076137e-01_rb,&
+        & 5.059860e-01_rb,5.043911e-01_rb,5.028266e-01_rb,5.012904e-01_rb,4.997805e-01_rb,&
+        & 4.982951e-01_rb,4.968326e-01_rb,4.953913e-01_rb /)
+
+! asymmetry factor: unitless
+      asyice2(:, 16) = (/ &
+! band 16
+        & 7.946655e-01_rb,8.547685e-01_rb,8.806016e-01_rb,8.949880e-01_rb,9.041676e-01_rb,&
+        & 9.105399e-01_rb,9.152249e-01_rb,9.188160e-01_rb,9.216573e-01_rb,9.239620e-01_rb,&
+        & 9.258695e-01_rb,9.274745e-01_rb,9.288441e-01_rb,9.300267e-01_rb,9.310584e-01_rb,&
+        & 9.319665e-01_rb,9.327721e-01_rb,9.334918e-01_rb,9.341387e-01_rb,9.347236e-01_rb,&
+        & 9.352551e-01_rb,9.357402e-01_rb,9.361850e-01_rb,9.365942e-01_rb,9.369722e-01_rb,&
+        & 9.373225e-01_rb,9.376481e-01_rb,9.379516e-01_rb,9.382352e-01_rb,9.385010e-01_rb,&
+        & 9.387505e-01_rb,9.389854e-01_rb,9.392070e-01_rb,9.394163e-01_rb,9.396145e-01_rb,&
+        & 9.398024e-01_rb,9.399809e-01_rb,9.401508e-01_rb,9.403126e-01_rb,9.404670e-01_rb,&
+        & 9.406144e-01_rb,9.407555e-01_rb,9.408906e-01_rb /)
+      asyice2(:, 17) = (/ &
+! band 17
+        & 9.078091e-01_rb,9.195850e-01_rb,9.267250e-01_rb,9.317083e-01_rb,9.354632e-01_rb,&
+        & 9.384323e-01_rb,9.408597e-01_rb,9.428935e-01_rb,9.446301e-01_rb,9.461351e-01_rb,&
+        & 9.474555e-01_rb,9.486259e-01_rb,9.496722e-01_rb,9.506146e-01_rb,9.514688e-01_rb,&
+        & 9.522476e-01_rb,9.529612e-01_rb,9.536181e-01_rb,9.542251e-01_rb,9.547883e-01_rb,&
+        & 9.553124e-01_rb,9.558019e-01_rb,9.562601e-01_rb,9.566904e-01_rb,9.570953e-01_rb,&
+        & 9.574773e-01_rb,9.578385e-01_rb,9.581806e-01_rb,9.585054e-01_rb,9.588142e-01_rb,&
+        & 9.591083e-01_rb,9.593888e-01_rb,9.596569e-01_rb,9.599135e-01_rb,9.601593e-01_rb,&
+        & 9.603952e-01_rb,9.606219e-01_rb,9.608399e-01_rb,9.610499e-01_rb,9.612523e-01_rb,&
+        & 9.614477e-01_rb,9.616365e-01_rb,9.618192e-01_rb /)
+      asyice2(:, 18) = (/ &
+! band 18
+        & 8.322045e-01_rb,8.528693e-01_rb,8.648167e-01_rb,8.729163e-01_rb,8.789054e-01_rb,&
+        & 8.835845e-01_rb,8.873819e-01_rb,8.905511e-01_rb,8.932532e-01_rb,8.955965e-01_rb,&
+        & 8.976567e-01_rb,8.994887e-01_rb,9.011334e-01_rb,9.026221e-01_rb,9.039791e-01_rb,&
+        & 9.052237e-01_rb,9.063715e-01_rb,9.074349e-01_rb,9.084245e-01_rb,9.093489e-01_rb,&
+        & 9.102154e-01_rb,9.110303e-01_rb,9.117987e-01_rb,9.125253e-01_rb,9.132140e-01_rb,&
+        & 9.138682e-01_rb,9.144910e-01_rb,9.150850e-01_rb,9.156524e-01_rb,9.161955e-01_rb,&
+        & 9.167160e-01_rb,9.172157e-01_rb,9.176959e-01_rb,9.181581e-01_rb,9.186034e-01_rb,&
+        & 9.190330e-01_rb,9.194478e-01_rb,9.198488e-01_rb,9.202368e-01_rb,9.206126e-01_rb,&
+        & 9.209768e-01_rb,9.213301e-01_rb,9.216731e-01_rb /)
+      asyice2(:, 19) = (/ &
+! band 19
+        & 8.116560e-01_rb,8.488278e-01_rb,8.674331e-01_rb,8.788148e-01_rb,8.865810e-01_rb,&
+        & 8.922595e-01_rb,8.966149e-01_rb,9.000747e-01_rb,9.028980e-01_rb,9.052513e-01_rb,&
+        & 9.072468e-01_rb,9.089632e-01_rb,9.104574e-01_rb,9.117713e-01_rb,9.129371e-01_rb,&
+        & 9.139793e-01_rb,9.149174e-01_rb,9.157668e-01_rb,9.165400e-01_rb,9.172473e-01_rb,&
+        & 9.178970e-01_rb,9.184962e-01_rb,9.190508e-01_rb,9.195658e-01_rb,9.200455e-01_rb,&
+        & 9.204935e-01_rb,9.209130e-01_rb,9.213067e-01_rb,9.216771e-01_rb,9.220262e-01_rb,&
+        & 9.223560e-01_rb,9.226680e-01_rb,9.229636e-01_rb,9.232443e-01_rb,9.235112e-01_rb,&
+        & 9.237652e-01_rb,9.240074e-01_rb,9.242385e-01_rb,9.244594e-01_rb,9.246708e-01_rb,&
+        & 9.248733e-01_rb,9.250674e-01_rb,9.252536e-01_rb /)
+      asyice2(:, 20) = (/ &
+! band 20
+        & 8.047113e-01_rb,8.402864e-01_rb,8.570332e-01_rb,8.668455e-01_rb,8.733206e-01_rb,&
+        & 8.779272e-01_rb,8.813796e-01_rb,8.840676e-01_rb,8.862225e-01_rb,8.879904e-01_rb,&
+        & 8.894682e-01_rb,8.907228e-01_rb,8.918019e-01_rb,8.927404e-01_rb,8.935645e-01_rb,&
+        & 8.942943e-01_rb,8.949452e-01_rb,8.955296e-01_rb,8.960574e-01_rb,8.965366e-01_rb,&
+        & 8.969736e-01_rb,8.973740e-01_rb,8.977422e-01_rb,8.980820e-01_rb,8.983966e-01_rb,&
+        & 8.986889e-01_rb,8.989611e-01_rb,8.992153e-01_rb,8.994533e-01_rb,8.996766e-01_rb,&
+        & 8.998865e-01_rb,9.000843e-01_rb,9.002709e-01_rb,9.004474e-01_rb,9.006146e-01_rb,&
+        & 9.007731e-01_rb,9.009237e-01_rb,9.010670e-01_rb,9.012034e-01_rb,9.013336e-01_rb,&
+        & 9.014579e-01_rb,9.015767e-01_rb,9.016904e-01_rb /)
+      asyice2(:, 21) = (/ &
+! band 21
+        & 8.179122e-01_rb,8.480726e-01_rb,8.621945e-01_rb,8.704354e-01_rb,8.758555e-01_rb,&
+        & 8.797007e-01_rb,8.825750e-01_rb,8.848078e-01_rb,8.865939e-01_rb,8.880564e-01_rb,&
+        & 8.892765e-01_rb,8.903105e-01_rb,8.911982e-01_rb,8.919689e-01_rb,8.926446e-01_rb,&
+        & 8.932419e-01_rb,8.937738e-01_rb,8.942506e-01_rb,8.946806e-01_rb,8.950702e-01_rb,&
+        & 8.954251e-01_rb,8.957497e-01_rb,8.960477e-01_rb,8.963223e-01_rb,8.965762e-01_rb,&
+        & 8.968116e-01_rb,8.970306e-01_rb,8.972347e-01_rb,8.974255e-01_rb,8.976042e-01_rb,&
+        & 8.977720e-01_rb,8.979298e-01_rb,8.980784e-01_rb,8.982188e-01_rb,8.983515e-01_rb,&
+        & 8.984771e-01_rb,8.985963e-01_rb,8.987095e-01_rb,8.988171e-01_rb,8.989195e-01_rb,&
+        & 8.990172e-01_rb,8.991104e-01_rb,8.991994e-01_rb /)
+      asyice2(:, 22) = (/ &
+! band 22
+        & 8.169789e-01_rb,8.455024e-01_rb,8.586925e-01_rb,8.663283e-01_rb,8.713217e-01_rb,&
+        & 8.748488e-01_rb,8.774765e-01_rb,8.795122e-01_rb,8.811370e-01_rb,8.824649e-01_rb,&
+        & 8.835711e-01_rb,8.845073e-01_rb,8.853103e-01_rb,8.860068e-01_rb,8.866170e-01_rb,&
+        & 8.871560e-01_rb,8.876358e-01_rb,8.880658e-01_rb,8.884533e-01_rb,8.888044e-01_rb,&
+        & 8.891242e-01_rb,8.894166e-01_rb,8.896851e-01_rb,8.899324e-01_rb,8.901612e-01_rb,&
+        & 8.903733e-01_rb,8.905706e-01_rb,8.907545e-01_rb,8.909265e-01_rb,8.910876e-01_rb,&
+        & 8.912388e-01_rb,8.913812e-01_rb,8.915153e-01_rb,8.916419e-01_rb,8.917617e-01_rb,&
+        & 8.918752e-01_rb,8.919829e-01_rb,8.920851e-01_rb,8.921824e-01_rb,8.922751e-01_rb,&
+        & 8.923635e-01_rb,8.924478e-01_rb,8.925284e-01_rb /)
+      asyice2(:, 23) = (/ &
+! band 23
+        & 8.387642e-01_rb,8.569979e-01_rb,8.658630e-01_rb,8.711825e-01_rb,8.747605e-01_rb,&
+        & 8.773472e-01_rb,8.793129e-01_rb,8.808621e-01_rb,8.821179e-01_rb,8.831583e-01_rb,&
+        & 8.840361e-01_rb,8.847875e-01_rb,8.854388e-01_rb,8.860094e-01_rb,8.865138e-01_rb,&
+        & 8.869634e-01_rb,8.873668e-01_rb,8.877310e-01_rb,8.880617e-01_rb,8.883635e-01_rb,&
+        & 8.886401e-01_rb,8.888947e-01_rb,8.891298e-01_rb,8.893477e-01_rb,8.895504e-01_rb,&
+        & 8.897393e-01_rb,8.899159e-01_rb,8.900815e-01_rb,8.902370e-01_rb,8.903833e-01_rb,&
+        & 8.905214e-01_rb,8.906518e-01_rb,8.907753e-01_rb,8.908924e-01_rb,8.910036e-01_rb,&
+        & 8.911094e-01_rb,8.912101e-01_rb,8.913062e-01_rb,8.913979e-01_rb,8.914856e-01_rb,&
+        & 8.915695e-01_rb,8.916498e-01_rb,8.917269e-01_rb /)
+      asyice2(:, 24) = (/ &
+! band 24
+        & 8.522208e-01_rb,8.648132e-01_rb,8.711224e-01_rb,8.749901e-01_rb,8.776354e-01_rb,&
+        & 8.795743e-01_rb,8.810649e-01_rb,8.822518e-01_rb,8.832225e-01_rb,8.840333e-01_rb,&
+        & 8.847224e-01_rb,8.853162e-01_rb,8.858342e-01_rb,8.862906e-01_rb,8.866962e-01_rb,&
+        & 8.870595e-01_rb,8.873871e-01_rb,8.876842e-01_rb,8.879551e-01_rb,8.882032e-01_rb,&
+        & 8.884316e-01_rb,8.886425e-01_rb,8.888380e-01_rb,8.890199e-01_rb,8.891895e-01_rb,&
+        & 8.893481e-01_rb,8.894968e-01_rb,8.896366e-01_rb,8.897683e-01_rb,8.898926e-01_rb,&
+        & 8.900102e-01_rb,8.901215e-01_rb,8.902272e-01_rb,8.903276e-01_rb,8.904232e-01_rb,&
+        & 8.905144e-01_rb,8.906014e-01_rb,8.906845e-01_rb,8.907640e-01_rb,8.908402e-01_rb,&
+        & 8.909132e-01_rb,8.909834e-01_rb,8.910507e-01_rb /)
+      asyice2(:, 25) = (/ &
+! band 25
+        & 8.578202e-01_rb,8.683033e-01_rb,8.735431e-01_rb,8.767488e-01_rb,8.789378e-01_rb,&
+        & 8.805399e-01_rb,8.817701e-01_rb,8.827485e-01_rb,8.835480e-01_rb,8.842152e-01_rb,&
+        & 8.847817e-01_rb,8.852696e-01_rb,8.856949e-01_rb,8.860694e-01_rb,8.864020e-01_rb,&
+        & 8.866997e-01_rb,8.869681e-01_rb,8.872113e-01_rb,8.874330e-01_rb,8.876360e-01_rb,&
+        & 8.878227e-01_rb,8.879951e-01_rb,8.881548e-01_rb,8.883033e-01_rb,8.884418e-01_rb,&
+        & 8.885712e-01_rb,8.886926e-01_rb,8.888066e-01_rb,8.889139e-01_rb,8.890152e-01_rb,&
+        & 8.891110e-01_rb,8.892017e-01_rb,8.892877e-01_rb,8.893695e-01_rb,8.894473e-01_rb,&
+        & 8.895214e-01_rb,8.895921e-01_rb,8.896597e-01_rb,8.897243e-01_rb,8.897862e-01_rb,&
+        & 8.898456e-01_rb,8.899025e-01_rb,8.899572e-01_rb /)
+      asyice2(:, 26) = (/ &
+! band 26
+        & 8.625615e-01_rb,8.713831e-01_rb,8.755799e-01_rb,8.780560e-01_rb,8.796983e-01_rb,&
+        & 8.808714e-01_rb,8.817534e-01_rb,8.824420e-01_rb,8.829953e-01_rb,8.834501e-01_rb,&
+        & 8.838310e-01_rb,8.841549e-01_rb,8.844338e-01_rb,8.846767e-01_rb,8.848902e-01_rb,&
+        & 8.850795e-01_rb,8.852484e-01_rb,8.854002e-01_rb,8.855374e-01_rb,8.856620e-01_rb,&
+        & 8.857758e-01_rb,8.858800e-01_rb,8.859759e-01_rb,8.860644e-01_rb,8.861464e-01_rb,&
+        & 8.862225e-01_rb,8.862935e-01_rb,8.863598e-01_rb,8.864218e-01_rb,8.864800e-01_rb,&
+        & 8.865347e-01_rb,8.865863e-01_rb,8.866349e-01_rb,8.866809e-01_rb,8.867245e-01_rb,&
+        & 8.867658e-01_rb,8.868050e-01_rb,8.868423e-01_rb,8.868778e-01_rb,8.869117e-01_rb,&
+        & 8.869440e-01_rb,8.869749e-01_rb,8.870044e-01_rb /)
+      asyice2(:, 27) = (/ &
+! band 27
+        & 8.587495e-01_rb,8.684764e-01_rb,8.728189e-01_rb,8.752872e-01_rb,8.768846e-01_rb,&
+        & 8.780060e-01_rb,8.788386e-01_rb,8.794824e-01_rb,8.799960e-01_rb,8.804159e-01_rb,&
+        & 8.807660e-01_rb,8.810626e-01_rb,8.813175e-01_rb,8.815390e-01_rb,8.817335e-01_rb,&
+        & 8.819057e-01_rb,8.820593e-01_rb,8.821973e-01_rb,8.823220e-01_rb,8.824353e-01_rb,&
+        & 8.825387e-01_rb,8.826336e-01_rb,8.827209e-01_rb,8.828016e-01_rb,8.828764e-01_rb,&
+        & 8.829459e-01_rb,8.830108e-01_rb,8.830715e-01_rb,8.831283e-01_rb,8.831817e-01_rb,&
+        & 8.832320e-01_rb,8.832795e-01_rb,8.833244e-01_rb,8.833668e-01_rb,8.834071e-01_rb,&
+        & 8.834454e-01_rb,8.834817e-01_rb,8.835164e-01_rb,8.835495e-01_rb,8.835811e-01_rb,&
+        & 8.836113e-01_rb,8.836402e-01_rb,8.836679e-01_rb /)
+      asyice2(:, 28) = (/ &
+! band 28
+        & 8.561110e-01_rb,8.678583e-01_rb,8.727554e-01_rb,8.753892e-01_rb,8.770154e-01_rb,&
+        & 8.781109e-01_rb,8.788949e-01_rb,8.794812e-01_rb,8.799348e-01_rb,8.802952e-01_rb,&
+        & 8.805880e-01_rb,8.808300e-01_rb,8.810331e-01_rb,8.812058e-01_rb,8.813543e-01_rb,&
+        & 8.814832e-01_rb,8.815960e-01_rb,8.816956e-01_rb,8.817839e-01_rb,8.818629e-01_rb,&
+        & 8.819339e-01_rb,8.819979e-01_rb,8.820560e-01_rb,8.821089e-01_rb,8.821573e-01_rb,&
+        & 8.822016e-01_rb,8.822425e-01_rb,8.822801e-01_rb,8.823150e-01_rb,8.823474e-01_rb,&
+        & 8.823775e-01_rb,8.824056e-01_rb,8.824318e-01_rb,8.824564e-01_rb,8.824795e-01_rb,&
+        & 8.825011e-01_rb,8.825215e-01_rb,8.825408e-01_rb,8.825589e-01_rb,8.825761e-01_rb,&
+        & 8.825924e-01_rb,8.826078e-01_rb,8.826224e-01_rb /)
+      asyice2(:, 29) = (/ &
+! band 29
+        & 8.311124e-01_rb,8.688197e-01_rb,8.900274e-01_rb,9.040696e-01_rb,9.142334e-01_rb,&
+        & 9.220181e-01_rb,9.282195e-01_rb,9.333048e-01_rb,9.375689e-01_rb,9.412085e-01_rb,&
+        & 9.443604e-01_rb,9.471230e-01_rb,9.495694e-01_rb,9.517549e-01_rb,9.537224e-01_rb,&
+        & 9.555057e-01_rb,9.571316e-01_rb,9.586222e-01_rb,9.599952e-01_rb,9.612656e-01_rb,&
+        & 9.624458e-01_rb,9.635461e-01_rb,9.645756e-01_rb,9.655418e-01_rb,9.664513e-01_rb,&
+        & 9.673098e-01_rb,9.681222e-01_rb,9.688928e-01_rb,9.696256e-01_rb,9.703237e-01_rb,&
+        & 9.709903e-01_rb,9.716280e-01_rb,9.722391e-01_rb,9.728258e-01_rb,9.733901e-01_rb,&
+        & 9.739336e-01_rb,9.744579e-01_rb,9.749645e-01_rb,9.754546e-01_rb,9.759294e-01_rb,&
+        & 9.763901e-01_rb,9.768376e-01_rb,9.772727e-01_rb /)
+
+! Hexagonal Ice Particle Parameterization
+! extinction units (ext coef/iwc): [(m^-1)/(g m^-3)]
+      extice3(:, 16) = (/ &
+! band 16
+        & 5.194013e-01_rb,3.215089e-01_rb,2.327917e-01_rb,1.824424e-01_rb,1.499977e-01_rb,&
+        & 1.273492e-01_rb,1.106421e-01_rb,9.780982e-02_rb,8.764435e-02_rb,7.939266e-02_rb,&
+        & 7.256081e-02_rb,6.681137e-02_rb,6.190600e-02_rb,5.767154e-02_rb,5.397915e-02_rb,&
+        & 5.073102e-02_rb,4.785151e-02_rb,4.528125e-02_rb,4.297296e-02_rb,4.088853e-02_rb,&
+        & 3.899690e-02_rb,3.727251e-02_rb,3.569411e-02_rb,3.424393e-02_rb,3.290694e-02_rb,&
+        & 3.167040e-02_rb,3.052340e-02_rb,2.945654e-02_rb,2.846172e-02_rb,2.753188e-02_rb,&
+        & 2.666085e-02_rb,2.584322e-02_rb,2.507423e-02_rb,2.434967e-02_rb,2.366579e-02_rb,&
+        & 2.301926e-02_rb,2.240711e-02_rb,2.182666e-02_rb,2.127551e-02_rb,2.075150e-02_rb,&
+        & 2.025267e-02_rb,1.977725e-02_rb,1.932364e-02_rb,1.889035e-02_rb,1.847607e-02_rb,&
+        & 1.807956e-02_rb /)
+      extice3(:, 17) = (/ &
+! band 17
+        & 4.901155e-01_rb,3.065286e-01_rb,2.230800e-01_rb,1.753951e-01_rb,1.445402e-01_rb,&
+        & 1.229417e-01_rb,1.069777e-01_rb,9.469760e-02_rb,8.495824e-02_rb,7.704501e-02_rb,&
+        & 7.048834e-02_rb,6.496693e-02_rb,6.025353e-02_rb,5.618286e-02_rb,5.263186e-02_rb,&
+        & 4.950698e-02_rb,4.673585e-02_rb,4.426164e-02_rb,4.203904e-02_rb,4.003153e-02_rb,&
+        & 3.820932e-02_rb,3.654790e-02_rb,3.502688e-02_rb,3.362919e-02_rb,3.234041e-02_rb,&
+        & 3.114829e-02_rb,3.004234e-02_rb,2.901356e-02_rb,2.805413e-02_rb,2.715727e-02_rb,&
+        & 2.631705e-02_rb,2.552828e-02_rb,2.478637e-02_rb,2.408725e-02_rb,2.342734e-02_rb,&
+        & 2.280343e-02_rb,2.221264e-02_rb,2.165242e-02_rb,2.112043e-02_rb,2.061461e-02_rb,&
+        & 2.013308e-02_rb,1.967411e-02_rb,1.923616e-02_rb,1.881783e-02_rb,1.841781e-02_rb,&
+        & 1.803494e-02_rb /)
+      extice3(:, 18) = (/ &
+! band 18
+        & 5.056264e-01_rb,3.160261e-01_rb,2.298442e-01_rb,1.805973e-01_rb,1.487318e-01_rb,&
+        & 1.264258e-01_rb,1.099389e-01_rb,9.725656e-02_rb,8.719819e-02_rb,7.902576e-02_rb,&
+        & 7.225433e-02_rb,6.655206e-02_rb,6.168427e-02_rb,5.748028e-02_rb,5.381296e-02_rb,&
+        & 5.058572e-02_rb,4.772383e-02_rb,4.516857e-02_rb,4.287317e-02_rb,4.079990e-02_rb,&
+        & 3.891801e-02_rb,3.720217e-02_rb,3.563133e-02_rb,3.418786e-02_rb,3.285686e-02_rb,&
+        & 3.162569e-02_rb,3.048352e-02_rb,2.942104e-02_rb,2.843018e-02_rb,2.750395e-02_rb,&
+        & 2.663621e-02_rb,2.582160e-02_rb,2.505539e-02_rb,2.433337e-02_rb,2.365185e-02_rb,&
+        & 2.300750e-02_rb,2.239736e-02_rb,2.181878e-02_rb,2.126937e-02_rb,2.074699e-02_rb,&
+        & 2.024968e-02_rb,1.977567e-02_rb,1.932338e-02_rb,1.889134e-02_rb,1.847823e-02_rb,&
+        & 1.808281e-02_rb /)
+      extice3(:, 19) = (/ &
+! band 19
+        & 4.881605e-01_rb,3.055237e-01_rb,2.225070e-01_rb,1.750688e-01_rb,1.443736e-01_rb,&
+        & 1.228869e-01_rb,1.070054e-01_rb,9.478893e-02_rb,8.509997e-02_rb,7.722769e-02_rb,&
+        & 7.070495e-02_rb,6.521211e-02_rb,6.052311e-02_rb,5.647351e-02_rb,5.294088e-02_rb,&
+        & 4.983217e-02_rb,4.707539e-02_rb,4.461398e-02_rb,4.240288e-02_rb,4.040575e-02_rb,&
+        & 3.859298e-02_rb,3.694016e-02_rb,3.542701e-02_rb,3.403655e-02_rb,3.275444e-02_rb,&
+        & 3.156849e-02_rb,3.046827e-02_rb,2.944481e-02_rb,2.849034e-02_rb,2.759812e-02_rb,&
+        & 2.676226e-02_rb,2.597757e-02_rb,2.523949e-02_rb,2.454400e-02_rb,2.388750e-02_rb,&
+        & 2.326682e-02_rb,2.267909e-02_rb,2.212176e-02_rb,2.159253e-02_rb,2.108933e-02_rb,&
+        & 2.061028e-02_rb,2.015369e-02_rb,1.971801e-02_rb,1.930184e-02_rb,1.890389e-02_rb,&
+        & 1.852300e-02_rb /)
+      extice3(:, 20) = (/ &
+! band 20
+        & 5.103703e-01_rb,3.188144e-01_rb,2.317435e-01_rb,1.819887e-01_rb,1.497944e-01_rb,&
+        & 1.272584e-01_rb,1.106013e-01_rb,9.778822e-02_rb,8.762610e-02_rb,7.936938e-02_rb,&
+        & 7.252809e-02_rb,6.676701e-02_rb,6.184901e-02_rb,5.760165e-02_rb,5.389651e-02_rb,&
+        & 5.063598e-02_rb,4.774457e-02_rb,4.516295e-02_rb,4.284387e-02_rb,4.074922e-02_rb,&
+        & 3.884792e-02_rb,3.711438e-02_rb,3.552734e-02_rb,3.406898e-02_rb,3.272425e-02_rb,&
+        & 3.148038e-02_rb,3.032643e-02_rb,2.925299e-02_rb,2.825191e-02_rb,2.731612e-02_rb,&
+        & 2.643943e-02_rb,2.561642e-02_rb,2.484230e-02_rb,2.411284e-02_rb,2.342429e-02_rb,&
+        & 2.277329e-02_rb,2.215686e-02_rb,2.157231e-02_rb,2.101724e-02_rb,2.048946e-02_rb,&
+        & 1.998702e-02_rb,1.950813e-02_rb,1.905118e-02_rb,1.861468e-02_rb,1.819730e-02_rb,&
+        & 1.779781e-02_rb /)
+      extice3(:, 21) = (/ &
+! band 21
+        & 5.031161e-01_rb,3.144511e-01_rb,2.286942e-01_rb,1.796903e-01_rb,1.479819e-01_rb,&
+        & 1.257860e-01_rb,1.093803e-01_rb,9.676059e-02_rb,8.675183e-02_rb,7.861971e-02_rb,&
+        & 7.188168e-02_rb,6.620754e-02_rb,6.136376e-02_rb,5.718050e-02_rb,5.353127e-02_rb,&
+        & 5.031995e-02_rb,4.747218e-02_rb,4.492952e-02_rb,4.264544e-02_rb,4.058240e-02_rb,&
+        & 3.870979e-02_rb,3.700242e-02_rb,3.543933e-02_rb,3.400297e-02_rb,3.267854e-02_rb,&
+        & 3.145345e-02_rb,3.031691e-02_rb,2.925967e-02_rb,2.827370e-02_rb,2.735203e-02_rb,&
+        & 2.648858e-02_rb,2.567798e-02_rb,2.491555e-02_rb,2.419710e-02_rb,2.351893e-02_rb,&
+        & 2.287776e-02_rb,2.227063e-02_rb,2.169491e-02_rb,2.114821e-02_rb,2.062840e-02_rb,&
+        & 2.013354e-02_rb,1.966188e-02_rb,1.921182e-02_rb,1.878191e-02_rb,1.837083e-02_rb,&
+        & 1.797737e-02_rb /)
+      extice3(:, 22) = (/ &
+! band 22
+        & 4.949453e-01_rb,3.095918e-01_rb,2.253402e-01_rb,1.771964e-01_rb,1.460446e-01_rb,&
+        & 1.242383e-01_rb,1.081206e-01_rb,9.572235e-02_rb,8.588928e-02_rb,7.789990e-02_rb,&
+        & 7.128013e-02_rb,6.570559e-02_rb,6.094684e-02_rb,5.683701e-02_rb,5.325183e-02_rb,&
+        & 5.009688e-02_rb,4.729909e-02_rb,4.480106e-02_rb,4.255708e-02_rb,4.053025e-02_rb,&
+        & 3.869051e-02_rb,3.701310e-02_rb,3.547745e-02_rb,3.406631e-02_rb,3.276512e-02_rb,&
+        & 3.156153e-02_rb,3.044494e-02_rb,2.940626e-02_rb,2.843759e-02_rb,2.753211e-02_rb,&
+        & 2.668381e-02_rb,2.588744e-02_rb,2.513839e-02_rb,2.443255e-02_rb,2.376629e-02_rb,&
+        & 2.313637e-02_rb,2.253990e-02_rb,2.197428e-02_rb,2.143718e-02_rb,2.092649e-02_rb,&
+        & 2.044032e-02_rb,1.997694e-02_rb,1.953478e-02_rb,1.911241e-02_rb,1.870855e-02_rb,&
+        & 1.832199e-02_rb /)
+      extice3(:, 23) = (/ &
+! band 23
+        & 5.052816e-01_rb,3.157665e-01_rb,2.296233e-01_rb,1.803986e-01_rb,1.485473e-01_rb,&
+        & 1.262514e-01_rb,1.097718e-01_rb,9.709524e-02_rb,8.704139e-02_rb,7.887264e-02_rb,&
+        & 7.210424e-02_rb,6.640454e-02_rb,6.153894e-02_rb,5.733683e-02_rb,5.367116e-02_rb,&
+        & 5.044537e-02_rb,4.758477e-02_rb,4.503066e-02_rb,4.273629e-02_rb,4.066395e-02_rb,&
+        & 3.878291e-02_rb,3.706784e-02_rb,3.549771e-02_rb,3.405488e-02_rb,3.272448e-02_rb,&
+        & 3.149387e-02_rb,3.035221e-02_rb,2.929020e-02_rb,2.829979e-02_rb,2.737397e-02_rb,&
+        & 2.650663e-02_rb,2.569238e-02_rb,2.492651e-02_rb,2.420482e-02_rb,2.352361e-02_rb,&
+        & 2.287954e-02_rb,2.226968e-02_rb,2.169136e-02_rb,2.114220e-02_rb,2.062005e-02_rb,&
+        & 2.012296e-02_rb,1.964917e-02_rb,1.919709e-02_rb,1.876524e-02_rb,1.835231e-02_rb,&
+        & 1.795707e-02_rb /)
+      extice3(:, 24) = (/ &
+! band 24
+        & 5.042067e-01_rb,3.151195e-01_rb,2.291708e-01_rb,1.800573e-01_rb,1.482779e-01_rb,&
+        & 1.260324e-01_rb,1.095900e-01_rb,9.694202e-02_rb,8.691087e-02_rb,7.876056e-02_rb,&
+        & 7.200745e-02_rb,6.632062e-02_rb,6.146600e-02_rb,5.727338e-02_rb,5.361599e-02_rb,&
+        & 5.039749e-02_rb,4.754334e-02_rb,4.499500e-02_rb,4.270580e-02_rb,4.063815e-02_rb,&
+        & 3.876135e-02_rb,3.705016e-02_rb,3.548357e-02_rb,3.404400e-02_rb,3.271661e-02_rb,&
+        & 3.148877e-02_rb,3.034969e-02_rb,2.929008e-02_rb,2.830191e-02_rb,2.737818e-02_rb,&
+        & 2.651279e-02_rb,2.570039e-02_rb,2.493624e-02_rb,2.421618e-02_rb,2.353650e-02_rb,&
+        & 2.289390e-02_rb,2.228541e-02_rb,2.170840e-02_rb,2.116048e-02_rb,2.063950e-02_rb,&
+        & 2.014354e-02_rb,1.967082e-02_rb,1.921975e-02_rb,1.878888e-02_rb,1.837688e-02_rb,&
+        & 1.798254e-02_rb /)
+      extice3(:, 25) = (/ &
+! band 25
+        & 5.022507e-01_rb,3.139246e-01_rb,2.283218e-01_rb,1.794059e-01_rb,1.477544e-01_rb,&
+        & 1.255984e-01_rb,1.092222e-01_rb,9.662516e-02_rb,8.663439e-02_rb,7.851688e-02_rb,&
+        & 7.179095e-02_rb,6.612700e-02_rb,6.129193e-02_rb,5.711618e-02_rb,5.347351e-02_rb,&
+        & 5.026796e-02_rb,4.742530e-02_rb,4.488721e-02_rb,4.260724e-02_rb,4.054790e-02_rb,&
+        & 3.867866e-02_rb,3.697435e-02_rb,3.541407e-02_rb,3.398029e-02_rb,3.265824e-02_rb,&
+        & 3.143535e-02_rb,3.030085e-02_rb,2.924551e-02_rb,2.826131e-02_rb,2.734130e-02_rb,&
+        & 2.647939e-02_rb,2.567026e-02_rb,2.490919e-02_rb,2.419203e-02_rb,2.351509e-02_rb,&
+        & 2.287507e-02_rb,2.226903e-02_rb,2.169434e-02_rb,2.114862e-02_rb,2.062975e-02_rb,&
+        & 2.013578e-02_rb,1.966496e-02_rb,1.921571e-02_rb,1.878658e-02_rb,1.837623e-02_rb,&
+        & 1.798348e-02_rb /)
+      extice3(:, 26) = (/ &
+! band 26
+        & 5.068316e-01_rb,3.166869e-01_rb,2.302576e-01_rb,1.808693e-01_rb,1.489122e-01_rb,&
+        & 1.265423e-01_rb,1.100080e-01_rb,9.728926e-02_rb,8.720201e-02_rb,7.900612e-02_rb,&
+        & 7.221524e-02_rb,6.649660e-02_rb,6.161484e-02_rb,5.739877e-02_rb,5.372093e-02_rb,&
+        & 5.048442e-02_rb,4.761431e-02_rb,4.505172e-02_rb,4.274972e-02_rb,4.067050e-02_rb,&
+        & 3.878321e-02_rb,3.706244e-02_rb,3.548710e-02_rb,3.403948e-02_rb,3.270466e-02_rb,&
+        & 3.146995e-02_rb,3.032450e-02_rb,2.925897e-02_rb,2.826527e-02_rb,2.733638e-02_rb,&
+        & 2.646615e-02_rb,2.564920e-02_rb,2.488078e-02_rb,2.415670e-02_rb,2.347322e-02_rb,&
+        & 2.282702e-02_rb,2.221513e-02_rb,2.163489e-02_rb,2.108390e-02_rb,2.056002e-02_rb,&
+        & 2.006128e-02_rb,1.958591e-02_rb,1.913232e-02_rb,1.869904e-02_rb,1.828474e-02_rb,&
+        & 1.788819e-02_rb /)
+      extice3(:, 27) = (/ &
+! band 27
+        & 5.077707e-01_rb,3.172636e-01_rb,2.306695e-01_rb,1.811871e-01_rb,1.491691e-01_rb,&
+        & 1.267565e-01_rb,1.101907e-01_rb,9.744773e-02_rb,8.734125e-02_rb,7.912973e-02_rb,&
+        & 7.232591e-02_rb,6.659637e-02_rb,6.170530e-02_rb,5.748120e-02_rb,5.379634e-02_rb,&
+        & 5.055367e-02_rb,4.767809e-02_rb,4.511061e-02_rb,4.280423e-02_rb,4.072104e-02_rb,&
+        & 3.883015e-02_rb,3.710611e-02_rb,3.552776e-02_rb,3.407738e-02_rb,3.274002e-02_rb,&
+        & 3.150296e-02_rb,3.035532e-02_rb,2.928776e-02_rb,2.829216e-02_rb,2.736150e-02_rb,&
+        & 2.648961e-02_rb,2.567111e-02_rb,2.490123e-02_rb,2.417576e-02_rb,2.349098e-02_rb,&
+        & 2.284354e-02_rb,2.223049e-02_rb,2.164914e-02_rb,2.109711e-02_rb,2.057222e-02_rb,&
+        & 2.007253e-02_rb,1.959626e-02_rb,1.914181e-02_rb,1.870770e-02_rb,1.829261e-02_rb,&
+        & 1.789531e-02_rb /)
+      extice3(:, 28) = (/ &
+! band 28
+        & 5.062281e-01_rb,3.163402e-01_rb,2.300275e-01_rb,1.807060e-01_rb,1.487921e-01_rb,&
+        & 1.264523e-01_rb,1.099403e-01_rb,9.723879e-02_rb,8.716516e-02_rb,7.898034e-02_rb,&
+        & 7.219863e-02_rb,6.648771e-02_rb,6.161254e-02_rb,5.740217e-02_rb,5.372929e-02_rb,&
+        & 5.049716e-02_rb,4.763092e-02_rb,4.507179e-02_rb,4.277290e-02_rb,4.069649e-02_rb,&
+        & 3.881175e-02_rb,3.709331e-02_rb,3.552008e-02_rb,3.407442e-02_rb,3.274141e-02_rb,&
+        & 3.150837e-02_rb,3.036447e-02_rb,2.930037e-02_rb,2.830801e-02_rb,2.738037e-02_rb,&
+        & 2.651132e-02_rb,2.569547e-02_rb,2.492810e-02_rb,2.420499e-02_rb,2.352243e-02_rb,&
+        & 2.287710e-02_rb,2.226604e-02_rb,2.168658e-02_rb,2.113634e-02_rb,2.061316e-02_rb,&
+        & 2.011510e-02_rb,1.964038e-02_rb,1.918740e-02_rb,1.875471e-02_rb,1.834096e-02_rb,&
+        & 1.794495e-02_rb /)
+      extice3(:, 29) = (/ &
+! band 29
+        & 1.338834e-01_rb,1.924912e-01_rb,1.755523e-01_rb,1.534793e-01_rb,1.343937e-01_rb,&
+        & 1.187883e-01_rb,1.060654e-01_rb,9.559106e-02_rb,8.685880e-02_rb,7.948698e-02_rb,&
+        & 7.319086e-02_rb,6.775669e-02_rb,6.302215e-02_rb,5.886236e-02_rb,5.517996e-02_rb,&
+        & 5.189810e-02_rb,4.895539e-02_rb,4.630225e-02_rb,4.389823e-02_rb,4.171002e-02_rb,&
+        & 3.970998e-02_rb,3.787493e-02_rb,3.618537e-02_rb,3.462471e-02_rb,3.317880e-02_rb,&
+        & 3.183547e-02_rb,3.058421e-02_rb,2.941590e-02_rb,2.832256e-02_rb,2.729724e-02_rb,&
+        & 2.633377e-02_rb,2.542675e-02_rb,2.457136e-02_rb,2.376332e-02_rb,2.299882e-02_rb,&
+        & 2.227443e-02_rb,2.158707e-02_rb,2.093400e-02_rb,2.031270e-02_rb,1.972091e-02_rb,&
+        & 1.915659e-02_rb,1.861787e-02_rb,1.810304e-02_rb,1.761055e-02_rb,1.713899e-02_rb,&
+        & 1.668704e-02_rb /)
+
+! single-scattering albedo: unitless
+      ssaice3(:, 16) = (/ &
+! band 16
+        & 6.749442e-01_rb,6.649947e-01_rb,6.565828e-01_rb,6.489928e-01_rb,6.420046e-01_rb,&
+        & 6.355231e-01_rb,6.294964e-01_rb,6.238901e-01_rb,6.186783e-01_rb,6.138395e-01_rb,&
+        & 6.093543e-01_rb,6.052049e-01_rb,6.013742e-01_rb,5.978457e-01_rb,5.946030e-01_rb,&
+        & 5.916302e-01_rb,5.889115e-01_rb,5.864310e-01_rb,5.841731e-01_rb,5.821221e-01_rb,&
+        & 5.802624e-01_rb,5.785785e-01_rb,5.770549e-01_rb,5.756759e-01_rb,5.744262e-01_rb,&
+        & 5.732901e-01_rb,5.722524e-01_rb,5.712974e-01_rb,5.704097e-01_rb,5.695739e-01_rb,&
+        & 5.687747e-01_rb,5.679964e-01_rb,5.672238e-01_rb,5.664415e-01_rb,5.656340e-01_rb,&
+        & 5.647860e-01_rb,5.638821e-01_rb,5.629070e-01_rb,5.618452e-01_rb,5.606815e-01_rb,&
+        & 5.594006e-01_rb,5.579870e-01_rb,5.564255e-01_rb,5.547008e-01_rb,5.527976e-01_rb,&
+        & 5.507005e-01_rb /)
+      ssaice3(:, 17) = (/ &
+! band 17
+        & 7.628550e-01_rb,7.567297e-01_rb,7.508463e-01_rb,7.451972e-01_rb,7.397745e-01_rb,&
+        & 7.345705e-01_rb,7.295775e-01_rb,7.247881e-01_rb,7.201945e-01_rb,7.157894e-01_rb,&
+        & 7.115652e-01_rb,7.075145e-01_rb,7.036300e-01_rb,6.999044e-01_rb,6.963304e-01_rb,&
+        & 6.929007e-01_rb,6.896083e-01_rb,6.864460e-01_rb,6.834067e-01_rb,6.804833e-01_rb,&
+        & 6.776690e-01_rb,6.749567e-01_rb,6.723397e-01_rb,6.698109e-01_rb,6.673637e-01_rb,&
+        & 6.649913e-01_rb,6.626870e-01_rb,6.604441e-01_rb,6.582561e-01_rb,6.561163e-01_rb,&
+        & 6.540182e-01_rb,6.519554e-01_rb,6.499215e-01_rb,6.479099e-01_rb,6.459145e-01_rb,&
+        & 6.439289e-01_rb,6.419468e-01_rb,6.399621e-01_rb,6.379686e-01_rb,6.359601e-01_rb,&
+        & 6.339306e-01_rb,6.318740e-01_rb,6.297845e-01_rb,6.276559e-01_rb,6.254825e-01_rb,&
+        & 6.232583e-01_rb /)
+      ssaice3(:, 18) = (/ &
+! band 18
+        & 9.924147e-01_rb,9.882792e-01_rb,9.842257e-01_rb,9.802522e-01_rb,9.763566e-01_rb,&
+        & 9.725367e-01_rb,9.687905e-01_rb,9.651157e-01_rb,9.615104e-01_rb,9.579725e-01_rb,&
+        & 9.544997e-01_rb,9.510901e-01_rb,9.477416e-01_rb,9.444520e-01_rb,9.412194e-01_rb,&
+        & 9.380415e-01_rb,9.349165e-01_rb,9.318421e-01_rb,9.288164e-01_rb,9.258373e-01_rb,&
+        & 9.229027e-01_rb,9.200106e-01_rb,9.171589e-01_rb,9.143457e-01_rb,9.115688e-01_rb,&
+        & 9.088263e-01_rb,9.061161e-01_rb,9.034362e-01_rb,9.007846e-01_rb,8.981592e-01_rb,&
+        & 8.955581e-01_rb,8.929792e-01_rb,8.904206e-01_rb,8.878803e-01_rb,8.853562e-01_rb,&
+        & 8.828464e-01_rb,8.803488e-01_rb,8.778616e-01_rb,8.753827e-01_rb,8.729102e-01_rb,&
+        & 8.704421e-01_rb,8.679764e-01_rb,8.655112e-01_rb,8.630445e-01_rb,8.605744e-01_rb,&
+        & 8.580989e-01_rb /)
+      ssaice3(:, 19) = (/ &
+! band 19
+        & 9.629413e-01_rb,9.517182e-01_rb,9.409209e-01_rb,9.305366e-01_rb,9.205529e-01_rb,&
+        & 9.109569e-01_rb,9.017362e-01_rb,8.928780e-01_rb,8.843699e-01_rb,8.761992e-01_rb,&
+        & 8.683536e-01_rb,8.608204e-01_rb,8.535873e-01_rb,8.466417e-01_rb,8.399712e-01_rb,&
+        & 8.335635e-01_rb,8.274062e-01_rb,8.214868e-01_rb,8.157932e-01_rb,8.103129e-01_rb,&
+        & 8.050336e-01_rb,7.999432e-01_rb,7.950294e-01_rb,7.902798e-01_rb,7.856825e-01_rb,&
+        & 7.812250e-01_rb,7.768954e-01_rb,7.726815e-01_rb,7.685711e-01_rb,7.645522e-01_rb,&
+        & 7.606126e-01_rb,7.567404e-01_rb,7.529234e-01_rb,7.491498e-01_rb,7.454074e-01_rb,&
+        & 7.416844e-01_rb,7.379688e-01_rb,7.342485e-01_rb,7.305118e-01_rb,7.267468e-01_rb,&
+        & 7.229415e-01_rb,7.190841e-01_rb,7.151628e-01_rb,7.111657e-01_rb,7.070811e-01_rb,&
+        & 7.028972e-01_rb /)
+      ssaice3(:, 20) = (/ &
+! band 20
+        & 9.942270e-01_rb,9.909206e-01_rb,9.876775e-01_rb,9.844960e-01_rb,9.813746e-01_rb,&
+        & 9.783114e-01_rb,9.753049e-01_rb,9.723535e-01_rb,9.694553e-01_rb,9.666088e-01_rb,&
+        & 9.638123e-01_rb,9.610641e-01_rb,9.583626e-01_rb,9.557060e-01_rb,9.530928e-01_rb,&
+        & 9.505211e-01_rb,9.479895e-01_rb,9.454961e-01_rb,9.430393e-01_rb,9.406174e-01_rb,&
+        & 9.382288e-01_rb,9.358717e-01_rb,9.335446e-01_rb,9.312456e-01_rb,9.289731e-01_rb,&
+        & 9.267255e-01_rb,9.245010e-01_rb,9.222980e-01_rb,9.201147e-01_rb,9.179496e-01_rb,&
+        & 9.158008e-01_rb,9.136667e-01_rb,9.115457e-01_rb,9.094359e-01_rb,9.073358e-01_rb,&
+        & 9.052436e-01_rb,9.031577e-01_rb,9.010763e-01_rb,8.989977e-01_rb,8.969203e-01_rb,&
+        & 8.948423e-01_rb,8.927620e-01_rb,8.906778e-01_rb,8.885879e-01_rb,8.864907e-01_rb,&
+        & 8.843843e-01_rb /)
+      ssaice3(:, 21) = (/ &
+! band 21
+        & 9.934014e-01_rb,9.899331e-01_rb,9.865537e-01_rb,9.832610e-01_rb,9.800523e-01_rb,&
+        & 9.769254e-01_rb,9.738777e-01_rb,9.709069e-01_rb,9.680106e-01_rb,9.651862e-01_rb,&
+        & 9.624315e-01_rb,9.597439e-01_rb,9.571212e-01_rb,9.545608e-01_rb,9.520605e-01_rb,&
+        & 9.496177e-01_rb,9.472301e-01_rb,9.448954e-01_rb,9.426111e-01_rb,9.403749e-01_rb,&
+        & 9.381843e-01_rb,9.360370e-01_rb,9.339307e-01_rb,9.318629e-01_rb,9.298313e-01_rb,&
+        & 9.278336e-01_rb,9.258673e-01_rb,9.239302e-01_rb,9.220198e-01_rb,9.201338e-01_rb,&
+        & 9.182700e-01_rb,9.164258e-01_rb,9.145991e-01_rb,9.127874e-01_rb,9.109884e-01_rb,&
+        & 9.091999e-01_rb,9.074194e-01_rb,9.056447e-01_rb,9.038735e-01_rb,9.021033e-01_rb,&
+        & 9.003320e-01_rb,8.985572e-01_rb,8.967766e-01_rb,8.949879e-01_rb,8.931888e-01_rb,&
+        & 8.913770e-01_rb /)
+      ssaice3(:, 22) = (/ &
+! band 22
+        & 9.994833e-01_rb,9.992055e-01_rb,9.989278e-01_rb,9.986500e-01_rb,9.983724e-01_rb,&
+        & 9.980947e-01_rb,9.978172e-01_rb,9.975397e-01_rb,9.972623e-01_rb,9.969849e-01_rb,&
+        & 9.967077e-01_rb,9.964305e-01_rb,9.961535e-01_rb,9.958765e-01_rb,9.955997e-01_rb,&
+        & 9.953230e-01_rb,9.950464e-01_rb,9.947699e-01_rb,9.944936e-01_rb,9.942174e-01_rb,&
+        & 9.939414e-01_rb,9.936656e-01_rb,9.933899e-01_rb,9.931144e-01_rb,9.928390e-01_rb,&
+        & 9.925639e-01_rb,9.922889e-01_rb,9.920141e-01_rb,9.917396e-01_rb,9.914652e-01_rb,&
+        & 9.911911e-01_rb,9.909171e-01_rb,9.906434e-01_rb,9.903700e-01_rb,9.900967e-01_rb,&
+        & 9.898237e-01_rb,9.895510e-01_rb,9.892784e-01_rb,9.890062e-01_rb,9.887342e-01_rb,&
+        & 9.884625e-01_rb,9.881911e-01_rb,9.879199e-01_rb,9.876490e-01_rb,9.873784e-01_rb,&
+        & 9.871081e-01_rb /)
+      ssaice3(:, 23) = (/ &
+! band 23
+        & 9.999343e-01_rb,9.998917e-01_rb,9.998492e-01_rb,9.998067e-01_rb,9.997642e-01_rb,&
+        & 9.997218e-01_rb,9.996795e-01_rb,9.996372e-01_rb,9.995949e-01_rb,9.995528e-01_rb,&
+        & 9.995106e-01_rb,9.994686e-01_rb,9.994265e-01_rb,9.993845e-01_rb,9.993426e-01_rb,&
+        & 9.993007e-01_rb,9.992589e-01_rb,9.992171e-01_rb,9.991754e-01_rb,9.991337e-01_rb,&
+        & 9.990921e-01_rb,9.990505e-01_rb,9.990089e-01_rb,9.989674e-01_rb,9.989260e-01_rb,&
+        & 9.988846e-01_rb,9.988432e-01_rb,9.988019e-01_rb,9.987606e-01_rb,9.987194e-01_rb,&
+        & 9.986782e-01_rb,9.986370e-01_rb,9.985959e-01_rb,9.985549e-01_rb,9.985139e-01_rb,&
+        & 9.984729e-01_rb,9.984319e-01_rb,9.983910e-01_rb,9.983502e-01_rb,9.983094e-01_rb,&
+        & 9.982686e-01_rb,9.982279e-01_rb,9.981872e-01_rb,9.981465e-01_rb,9.981059e-01_rb,&
+        & 9.980653e-01_rb /)
+      ssaice3(:, 24) = (/ &
+! band 24
+        & 9.999978e-01_rb,9.999965e-01_rb,9.999952e-01_rb,9.999939e-01_rb,9.999926e-01_rb,&
+        & 9.999913e-01_rb,9.999900e-01_rb,9.999887e-01_rb,9.999873e-01_rb,9.999860e-01_rb,&
+        & 9.999847e-01_rb,9.999834e-01_rb,9.999821e-01_rb,9.999808e-01_rb,9.999795e-01_rb,&
+        & 9.999782e-01_rb,9.999769e-01_rb,9.999756e-01_rb,9.999743e-01_rb,9.999730e-01_rb,&
+        & 9.999717e-01_rb,9.999704e-01_rb,9.999691e-01_rb,9.999678e-01_rb,9.999665e-01_rb,&
+        & 9.999652e-01_rb,9.999639e-01_rb,9.999626e-01_rb,9.999613e-01_rb,9.999600e-01_rb,&
+        & 9.999587e-01_rb,9.999574e-01_rb,9.999561e-01_rb,9.999548e-01_rb,9.999535e-01_rb,&
+        & 9.999522e-01_rb,9.999509e-01_rb,9.999496e-01_rb,9.999483e-01_rb,9.999470e-01_rb,&
+        & 9.999457e-01_rb,9.999444e-01_rb,9.999431e-01_rb,9.999418e-01_rb,9.999405e-01_rb,&
+        & 9.999392e-01_rb /)
+      ssaice3(:, 25) = (/ &
+! band 25
+        & 9.999994e-01_rb,9.999993e-01_rb,9.999991e-01_rb,9.999990e-01_rb,9.999989e-01_rb,&
+        & 9.999987e-01_rb,9.999986e-01_rb,9.999984e-01_rb,9.999983e-01_rb,9.999982e-01_rb,&
+        & 9.999980e-01_rb,9.999979e-01_rb,9.999977e-01_rb,9.999976e-01_rb,9.999975e-01_rb,&
+        & 9.999973e-01_rb,9.999972e-01_rb,9.999970e-01_rb,9.999969e-01_rb,9.999967e-01_rb,&
+        & 9.999966e-01_rb,9.999965e-01_rb,9.999963e-01_rb,9.999962e-01_rb,9.999960e-01_rb,&
+        & 9.999959e-01_rb,9.999957e-01_rb,9.999956e-01_rb,9.999954e-01_rb,9.999953e-01_rb,&
+        & 9.999952e-01_rb,9.999950e-01_rb,9.999949e-01_rb,9.999947e-01_rb,9.999946e-01_rb,&
+        & 9.999944e-01_rb,9.999943e-01_rb,9.999941e-01_rb,9.999940e-01_rb,9.999939e-01_rb,&
+        & 9.999937e-01_rb,9.999936e-01_rb,9.999934e-01_rb,9.999933e-01_rb,9.999931e-01_rb,&
+        & 9.999930e-01_rb /)
+      ssaice3(:, 26) = (/ &
+! band 26
+        & 9.999997e-01_rb,9.999995e-01_rb,9.999992e-01_rb,9.999990e-01_rb,9.999987e-01_rb,&
+        & 9.999985e-01_rb,9.999983e-01_rb,9.999980e-01_rb,9.999978e-01_rb,9.999976e-01_rb,&
+        & 9.999973e-01_rb,9.999971e-01_rb,9.999969e-01_rb,9.999967e-01_rb,9.999965e-01_rb,&
+        & 9.999963e-01_rb,9.999960e-01_rb,9.999958e-01_rb,9.999956e-01_rb,9.999954e-01_rb,&
+        & 9.999952e-01_rb,9.999950e-01_rb,9.999948e-01_rb,9.999946e-01_rb,9.999944e-01_rb,&
+        & 9.999942e-01_rb,9.999939e-01_rb,9.999937e-01_rb,9.999935e-01_rb,9.999933e-01_rb,&
+        & 9.999931e-01_rb,9.999929e-01_rb,9.999927e-01_rb,9.999925e-01_rb,9.999923e-01_rb,&
+        & 9.999920e-01_rb,9.999918e-01_rb,9.999916e-01_rb,9.999914e-01_rb,9.999911e-01_rb,&
+        & 9.999909e-01_rb,9.999907e-01_rb,9.999905e-01_rb,9.999902e-01_rb,9.999900e-01_rb,&
+        & 9.999897e-01_rb /)
+      ssaice3(:, 27) = (/ &
+! band 27
+        & 9.999991e-01_rb,9.999985e-01_rb,9.999980e-01_rb,9.999974e-01_rb,9.999968e-01_rb,&
+        & 9.999963e-01_rb,9.999957e-01_rb,9.999951e-01_rb,9.999946e-01_rb,9.999940e-01_rb,&
+        & 9.999934e-01_rb,9.999929e-01_rb,9.999923e-01_rb,9.999918e-01_rb,9.999912e-01_rb,&
+        & 9.999907e-01_rb,9.999901e-01_rb,9.999896e-01_rb,9.999891e-01_rb,9.999885e-01_rb,&
+        & 9.999880e-01_rb,9.999874e-01_rb,9.999869e-01_rb,9.999863e-01_rb,9.999858e-01_rb,&
+        & 9.999853e-01_rb,9.999847e-01_rb,9.999842e-01_rb,9.999836e-01_rb,9.999831e-01_rb,&
+        & 9.999826e-01_rb,9.999820e-01_rb,9.999815e-01_rb,9.999809e-01_rb,9.999804e-01_rb,&
+        & 9.999798e-01_rb,9.999793e-01_rb,9.999787e-01_rb,9.999782e-01_rb,9.999776e-01_rb,&
+        & 9.999770e-01_rb,9.999765e-01_rb,9.999759e-01_rb,9.999754e-01_rb,9.999748e-01_rb,&
+        & 9.999742e-01_rb /)
+      ssaice3(:, 28) = (/ &
+! band 28
+        & 9.999975e-01_rb,9.999961e-01_rb,9.999946e-01_rb,9.999931e-01_rb,9.999917e-01_rb,&
+        & 9.999903e-01_rb,9.999888e-01_rb,9.999874e-01_rb,9.999859e-01_rb,9.999845e-01_rb,&
+        & 9.999831e-01_rb,9.999816e-01_rb,9.999802e-01_rb,9.999788e-01_rb,9.999774e-01_rb,&
+        & 9.999759e-01_rb,9.999745e-01_rb,9.999731e-01_rb,9.999717e-01_rb,9.999702e-01_rb,&
+        & 9.999688e-01_rb,9.999674e-01_rb,9.999660e-01_rb,9.999646e-01_rb,9.999631e-01_rb,&
+        & 9.999617e-01_rb,9.999603e-01_rb,9.999589e-01_rb,9.999574e-01_rb,9.999560e-01_rb,&
+        & 9.999546e-01_rb,9.999532e-01_rb,9.999517e-01_rb,9.999503e-01_rb,9.999489e-01_rb,&
+        & 9.999474e-01_rb,9.999460e-01_rb,9.999446e-01_rb,9.999431e-01_rb,9.999417e-01_rb,&
+        & 9.999403e-01_rb,9.999388e-01_rb,9.999374e-01_rb,9.999359e-01_rb,9.999345e-01_rb,&
+        & 9.999330e-01_rb /)
+      ssaice3(:, 29) = (/ &
+! band 29
+        & 4.526500e-01_rb,5.287890e-01_rb,5.410487e-01_rb,5.459865e-01_rb,5.485149e-01_rb,&
+        & 5.498914e-01_rb,5.505895e-01_rb,5.508310e-01_rb,5.507364e-01_rb,5.503793e-01_rb,&
+        & 5.498090e-01_rb,5.490612e-01_rb,5.481637e-01_rb,5.471395e-01_rb,5.460083e-01_rb,&
+        & 5.447878e-01_rb,5.434946e-01_rb,5.421442e-01_rb,5.407514e-01_rb,5.393309e-01_rb,&
+        & 5.378970e-01_rb,5.364641e-01_rb,5.350464e-01_rb,5.336582e-01_rb,5.323140e-01_rb,&
+        & 5.310283e-01_rb,5.298158e-01_rb,5.286914e-01_rb,5.276704e-01_rb,5.267680e-01_rb,&
+        & 5.260000e-01_rb,5.253823e-01_rb,5.249311e-01_rb,5.246629e-01_rb,5.245946e-01_rb,&
+        & 5.247434e-01_rb,5.251268e-01_rb,5.257626e-01_rb,5.266693e-01_rb,5.278653e-01_rb,&
+        & 5.293698e-01_rb,5.312022e-01_rb,5.333823e-01_rb,5.359305e-01_rb,5.388676e-01_rb,&
+        & 5.422146e-01_rb /)
+
+! asymmetry factor: unitless
+      asyice3(:, 16) = (/ &
+! band 16
+        & 8.340752e-01_rb,8.435170e-01_rb,8.517487e-01_rb,8.592064e-01_rb,8.660387e-01_rb,&
+        & 8.723204e-01_rb,8.780997e-01_rb,8.834137e-01_rb,8.882934e-01_rb,8.927662e-01_rb,&
+        & 8.968577e-01_rb,9.005914e-01_rb,9.039899e-01_rb,9.070745e-01_rb,9.098659e-01_rb,&
+        & 9.123836e-01_rb,9.146466e-01_rb,9.166734e-01_rb,9.184817e-01_rb,9.200886e-01_rb,&
+        & 9.215109e-01_rb,9.227648e-01_rb,9.238661e-01_rb,9.248304e-01_rb,9.256727e-01_rb,&
+        & 9.264078e-01_rb,9.270505e-01_rb,9.276150e-01_rb,9.281156e-01_rb,9.285662e-01_rb,&
+        & 9.289806e-01_rb,9.293726e-01_rb,9.297557e-01_rb,9.301435e-01_rb,9.305491e-01_rb,&
+        & 9.309859e-01_rb,9.314671e-01_rb,9.320055e-01_rb,9.326140e-01_rb,9.333053e-01_rb,&
+        & 9.340919e-01_rb,9.349861e-01_rb,9.360000e-01_rb,9.371451e-01_rb,9.384329e-01_rb,&
+        & 9.398744e-01_rb /)
+      asyice3(:, 17) = (/ &
+! band 17
+        & 8.728160e-01_rb,8.777333e-01_rb,8.823754e-01_rb,8.867535e-01_rb,8.908785e-01_rb,&
+        & 8.947611e-01_rb,8.984118e-01_rb,9.018408e-01_rb,9.050582e-01_rb,9.080739e-01_rb,&
+        & 9.108976e-01_rb,9.135388e-01_rb,9.160068e-01_rb,9.183106e-01_rb,9.204595e-01_rb,&
+        & 9.224620e-01_rb,9.243271e-01_rb,9.260632e-01_rb,9.276788e-01_rb,9.291822e-01_rb,&
+        & 9.305817e-01_rb,9.318853e-01_rb,9.331012e-01_rb,9.342372e-01_rb,9.353013e-01_rb,&
+        & 9.363013e-01_rb,9.372450e-01_rb,9.381400e-01_rb,9.389939e-01_rb,9.398145e-01_rb,&
+        & 9.406092e-01_rb,9.413856e-01_rb,9.421511e-01_rb,9.429131e-01_rb,9.436790e-01_rb,&
+        & 9.444561e-01_rb,9.452517e-01_rb,9.460729e-01_rb,9.469270e-01_rb,9.478209e-01_rb,&
+        & 9.487617e-01_rb,9.497562e-01_rb,9.508112e-01_rb,9.519335e-01_rb,9.531294e-01_rb,&
+        & 9.544055e-01_rb /)
+      asyice3(:, 18) = (/ &
+! band 18
+        & 7.897566e-01_rb,7.948704e-01_rb,7.998041e-01_rb,8.045623e-01_rb,8.091495e-01_rb,&
+        & 8.135702e-01_rb,8.178290e-01_rb,8.219305e-01_rb,8.258790e-01_rb,8.296792e-01_rb,&
+        & 8.333355e-01_rb,8.368524e-01_rb,8.402343e-01_rb,8.434856e-01_rb,8.466108e-01_rb,&
+        & 8.496143e-01_rb,8.525004e-01_rb,8.552737e-01_rb,8.579384e-01_rb,8.604990e-01_rb,&
+        & 8.629597e-01_rb,8.653250e-01_rb,8.675992e-01_rb,8.697867e-01_rb,8.718916e-01_rb,&
+        & 8.739185e-01_rb,8.758715e-01_rb,8.777551e-01_rb,8.795734e-01_rb,8.813308e-01_rb,&
+        & 8.830315e-01_rb,8.846799e-01_rb,8.862802e-01_rb,8.878366e-01_rb,8.893534e-01_rb,&
+        & 8.908350e-01_rb,8.922854e-01_rb,8.937090e-01_rb,8.951099e-01_rb,8.964925e-01_rb,&
+        & 8.978609e-01_rb,8.992192e-01_rb,9.005718e-01_rb,9.019229e-01_rb,9.032765e-01_rb,&
+        & 9.046369e-01_rb /)
+      asyice3(:, 19) = (/ &
+! band 19
+        & 7.812615e-01_rb,7.887764e-01_rb,7.959664e-01_rb,8.028413e-01_rb,8.094109e-01_rb,&
+        & 8.156849e-01_rb,8.216730e-01_rb,8.273846e-01_rb,8.328294e-01_rb,8.380166e-01_rb,&
+        & 8.429556e-01_rb,8.476556e-01_rb,8.521258e-01_rb,8.563753e-01_rb,8.604131e-01_rb,&
+        & 8.642481e-01_rb,8.678893e-01_rb,8.713455e-01_rb,8.746254e-01_rb,8.777378e-01_rb,&
+        & 8.806914e-01_rb,8.834948e-01_rb,8.861566e-01_rb,8.886854e-01_rb,8.910897e-01_rb,&
+        & 8.933779e-01_rb,8.955586e-01_rb,8.976402e-01_rb,8.996311e-01_rb,9.015398e-01_rb,&
+        & 9.033745e-01_rb,9.051436e-01_rb,9.068555e-01_rb,9.085185e-01_rb,9.101410e-01_rb,&
+        & 9.117311e-01_rb,9.132972e-01_rb,9.148476e-01_rb,9.163905e-01_rb,9.179340e-01_rb,&
+        & 9.194864e-01_rb,9.210559e-01_rb,9.226505e-01_rb,9.242784e-01_rb,9.259476e-01_rb,&
+        & 9.276661e-01_rb /)
+      asyice3(:, 20) = (/ &
+! band 20
+        & 7.640720e-01_rb,7.691119e-01_rb,7.739941e-01_rb,7.787222e-01_rb,7.832998e-01_rb,&
+        & 7.877304e-01_rb,7.920177e-01_rb,7.961652e-01_rb,8.001765e-01_rb,8.040551e-01_rb,&
+        & 8.078044e-01_rb,8.114280e-01_rb,8.149294e-01_rb,8.183119e-01_rb,8.215791e-01_rb,&
+        & 8.247344e-01_rb,8.277812e-01_rb,8.307229e-01_rb,8.335629e-01_rb,8.363046e-01_rb,&
+        & 8.389514e-01_rb,8.415067e-01_rb,8.439738e-01_rb,8.463560e-01_rb,8.486568e-01_rb,&
+        & 8.508795e-01_rb,8.530274e-01_rb,8.551039e-01_rb,8.571122e-01_rb,8.590558e-01_rb,&
+        & 8.609378e-01_rb,8.627618e-01_rb,8.645309e-01_rb,8.662485e-01_rb,8.679178e-01_rb,&
+        & 8.695423e-01_rb,8.711251e-01_rb,8.726697e-01_rb,8.741792e-01_rb,8.756571e-01_rb,&
+        & 8.771065e-01_rb,8.785307e-01_rb,8.799331e-01_rb,8.813169e-01_rb,8.826854e-01_rb,&
+        & 8.840419e-01_rb /)
+      asyice3(:, 21) = (/ &
+! band 21
+        & 7.602598e-01_rb,7.651572e-01_rb,7.699014e-01_rb,7.744962e-01_rb,7.789452e-01_rb,&
+        & 7.832522e-01_rb,7.874205e-01_rb,7.914538e-01_rb,7.953555e-01_rb,7.991290e-01_rb,&
+        & 8.027777e-01_rb,8.063049e-01_rb,8.097140e-01_rb,8.130081e-01_rb,8.161906e-01_rb,&
+        & 8.192645e-01_rb,8.222331e-01_rb,8.250993e-01_rb,8.278664e-01_rb,8.305374e-01_rb,&
+        & 8.331153e-01_rb,8.356030e-01_rb,8.380037e-01_rb,8.403201e-01_rb,8.425553e-01_rb,&
+        & 8.447121e-01_rb,8.467935e-01_rb,8.488022e-01_rb,8.507412e-01_rb,8.526132e-01_rb,&
+        & 8.544210e-01_rb,8.561675e-01_rb,8.578554e-01_rb,8.594875e-01_rb,8.610665e-01_rb,&
+        & 8.625951e-01_rb,8.640760e-01_rb,8.655119e-01_rb,8.669055e-01_rb,8.682594e-01_rb,&
+        & 8.695763e-01_rb,8.708587e-01_rb,8.721094e-01_rb,8.733308e-01_rb,8.745255e-01_rb,&
+        & 8.756961e-01_rb /)
+      asyice3(:, 22) = (/ &
+! band 22
+        & 7.568957e-01_rb,7.606995e-01_rb,7.644072e-01_rb,7.680204e-01_rb,7.715402e-01_rb,&
+        & 7.749682e-01_rb,7.783057e-01_rb,7.815541e-01_rb,7.847148e-01_rb,7.877892e-01_rb,&
+        & 7.907786e-01_rb,7.936846e-01_rb,7.965084e-01_rb,7.992515e-01_rb,8.019153e-01_rb,&
+        & 8.045011e-01_rb,8.070103e-01_rb,8.094444e-01_rb,8.118048e-01_rb,8.140927e-01_rb,&
+        & 8.163097e-01_rb,8.184571e-01_rb,8.205364e-01_rb,8.225488e-01_rb,8.244958e-01_rb,&
+        & 8.263789e-01_rb,8.281993e-01_rb,8.299586e-01_rb,8.316580e-01_rb,8.332991e-01_rb,&
+        & 8.348831e-01_rb,8.364115e-01_rb,8.378857e-01_rb,8.393071e-01_rb,8.406770e-01_rb,&
+        & 8.419969e-01_rb,8.432682e-01_rb,8.444923e-01_rb,8.456706e-01_rb,8.468044e-01_rb,&
+        & 8.478952e-01_rb,8.489444e-01_rb,8.499533e-01_rb,8.509234e-01_rb,8.518561e-01_rb,&
+        & 8.527528e-01_rb /)
+      asyice3(:, 23) = (/ &
+! band 23
+        & 7.575066e-01_rb,7.606912e-01_rb,7.638236e-01_rb,7.669035e-01_rb,7.699306e-01_rb,&
+        & 7.729046e-01_rb,7.758254e-01_rb,7.786926e-01_rb,7.815060e-01_rb,7.842654e-01_rb,&
+        & 7.869705e-01_rb,7.896211e-01_rb,7.922168e-01_rb,7.947574e-01_rb,7.972428e-01_rb,&
+        & 7.996726e-01_rb,8.020466e-01_rb,8.043646e-01_rb,8.066262e-01_rb,8.088313e-01_rb,&
+        & 8.109796e-01_rb,8.130709e-01_rb,8.151049e-01_rb,8.170814e-01_rb,8.190001e-01_rb,&
+        & 8.208608e-01_rb,8.226632e-01_rb,8.244071e-01_rb,8.260924e-01_rb,8.277186e-01_rb,&
+        & 8.292856e-01_rb,8.307932e-01_rb,8.322411e-01_rb,8.336291e-01_rb,8.349570e-01_rb,&
+        & 8.362244e-01_rb,8.374312e-01_rb,8.385772e-01_rb,8.396621e-01_rb,8.406856e-01_rb,&
+        & 8.416476e-01_rb,8.425479e-01_rb,8.433861e-01_rb,8.441620e-01_rb,8.448755e-01_rb,&
+        & 8.455263e-01_rb /)
+      asyice3(:, 24) = (/ &
+! band 24
+        & 7.568829e-01_rb,7.597947e-01_rb,7.626745e-01_rb,7.655212e-01_rb,7.683337e-01_rb,&
+        & 7.711111e-01_rb,7.738523e-01_rb,7.765565e-01_rb,7.792225e-01_rb,7.818494e-01_rb,&
+        & 7.844362e-01_rb,7.869819e-01_rb,7.894854e-01_rb,7.919459e-01_rb,7.943623e-01_rb,&
+        & 7.967337e-01_rb,7.990590e-01_rb,8.013373e-01_rb,8.035676e-01_rb,8.057488e-01_rb,&
+        & 8.078802e-01_rb,8.099605e-01_rb,8.119890e-01_rb,8.139645e-01_rb,8.158862e-01_rb,&
+        & 8.177530e-01_rb,8.195641e-01_rb,8.213183e-01_rb,8.230149e-01_rb,8.246527e-01_rb,&
+        & 8.262308e-01_rb,8.277483e-01_rb,8.292042e-01_rb,8.305976e-01_rb,8.319275e-01_rb,&
+        & 8.331929e-01_rb,8.343929e-01_rb,8.355265e-01_rb,8.365928e-01_rb,8.375909e-01_rb,&
+        & 8.385197e-01_rb,8.393784e-01_rb,8.401659e-01_rb,8.408815e-01_rb,8.415240e-01_rb,&
+        & 8.420926e-01_rb /)
+      asyice3(:, 25) = (/ &
+! band 25
+        & 7.548616e-01_rb,7.575454e-01_rb,7.602153e-01_rb,7.628696e-01_rb,7.655067e-01_rb,&
+        & 7.681249e-01_rb,7.707225e-01_rb,7.732978e-01_rb,7.758492e-01_rb,7.783750e-01_rb,&
+        & 7.808735e-01_rb,7.833430e-01_rb,7.857819e-01_rb,7.881886e-01_rb,7.905612e-01_rb,&
+        & 7.928983e-01_rb,7.951980e-01_rb,7.974588e-01_rb,7.996789e-01_rb,8.018567e-01_rb,&
+        & 8.039905e-01_rb,8.060787e-01_rb,8.081196e-01_rb,8.101115e-01_rb,8.120527e-01_rb,&
+        & 8.139416e-01_rb,8.157764e-01_rb,8.175557e-01_rb,8.192776e-01_rb,8.209405e-01_rb,&
+        & 8.225427e-01_rb,8.240826e-01_rb,8.255585e-01_rb,8.269688e-01_rb,8.283117e-01_rb,&
+        & 8.295856e-01_rb,8.307889e-01_rb,8.319198e-01_rb,8.329767e-01_rb,8.339579e-01_rb,&
+        & 8.348619e-01_rb,8.356868e-01_rb,8.364311e-01_rb,8.370930e-01_rb,8.376710e-01_rb,&
+        & 8.381633e-01_rb /)
+      asyice3(:, 26) = (/ &
+! band 26
+        & 7.491854e-01_rb,7.518523e-01_rb,7.545089e-01_rb,7.571534e-01_rb,7.597839e-01_rb,&
+        & 7.623987e-01_rb,7.649959e-01_rb,7.675737e-01_rb,7.701303e-01_rb,7.726639e-01_rb,&
+        & 7.751727e-01_rb,7.776548e-01_rb,7.801084e-01_rb,7.825318e-01_rb,7.849230e-01_rb,&
+        & 7.872804e-01_rb,7.896020e-01_rb,7.918862e-01_rb,7.941309e-01_rb,7.963345e-01_rb,&
+        & 7.984951e-01_rb,8.006109e-01_rb,8.026802e-01_rb,8.047009e-01_rb,8.066715e-01_rb,&
+        & 8.085900e-01_rb,8.104546e-01_rb,8.122636e-01_rb,8.140150e-01_rb,8.157072e-01_rb,&
+        & 8.173382e-01_rb,8.189063e-01_rb,8.204096e-01_rb,8.218464e-01_rb,8.232148e-01_rb,&
+        & 8.245130e-01_rb,8.257391e-01_rb,8.268915e-01_rb,8.279682e-01_rb,8.289675e-01_rb,&
+        & 8.298875e-01_rb,8.307264e-01_rb,8.314824e-01_rb,8.321537e-01_rb,8.327385e-01_rb,&
+        & 8.332350e-01_rb /)
+      asyice3(:, 27) = (/ &
+! band 27
+        & 7.397086e-01_rb,7.424069e-01_rb,7.450955e-01_rb,7.477725e-01_rb,7.504362e-01_rb,&
+        & 7.530846e-01_rb,7.557159e-01_rb,7.583283e-01_rb,7.609199e-01_rb,7.634888e-01_rb,&
+        & 7.660332e-01_rb,7.685512e-01_rb,7.710411e-01_rb,7.735009e-01_rb,7.759288e-01_rb,&
+        & 7.783229e-01_rb,7.806814e-01_rb,7.830024e-01_rb,7.852841e-01_rb,7.875246e-01_rb,&
+        & 7.897221e-01_rb,7.918748e-01_rb,7.939807e-01_rb,7.960380e-01_rb,7.980449e-01_rb,&
+        & 7.999995e-01_rb,8.019000e-01_rb,8.037445e-01_rb,8.055311e-01_rb,8.072581e-01_rb,&
+        & 8.089235e-01_rb,8.105255e-01_rb,8.120623e-01_rb,8.135319e-01_rb,8.149326e-01_rb,&
+        & 8.162626e-01_rb,8.175198e-01_rb,8.187025e-01_rb,8.198089e-01_rb,8.208371e-01_rb,&
+        & 8.217852e-01_rb,8.226514e-01_rb,8.234338e-01_rb,8.241306e-01_rb,8.247399e-01_rb,&
+        & 8.252599e-01_rb /)
+      asyice3(:, 28) = (/ &
+! band 28
+        & 7.224533e-01_rb,7.251681e-01_rb,7.278728e-01_rb,7.305654e-01_rb,7.332444e-01_rb,&
+        & 7.359078e-01_rb,7.385539e-01_rb,7.411808e-01_rb,7.437869e-01_rb,7.463702e-01_rb,&
+        & 7.489291e-01_rb,7.514616e-01_rb,7.539661e-01_rb,7.564408e-01_rb,7.588837e-01_rb,&
+        & 7.612933e-01_rb,7.636676e-01_rb,7.660049e-01_rb,7.683034e-01_rb,7.705612e-01_rb,&
+        & 7.727767e-01_rb,7.749480e-01_rb,7.770733e-01_rb,7.791509e-01_rb,7.811789e-01_rb,&
+        & 7.831556e-01_rb,7.850791e-01_rb,7.869478e-01_rb,7.887597e-01_rb,7.905131e-01_rb,&
+        & 7.922062e-01_rb,7.938372e-01_rb,7.954044e-01_rb,7.969059e-01_rb,7.983399e-01_rb,&
+        & 7.997047e-01_rb,8.009985e-01_rb,8.022195e-01_rb,8.033658e-01_rb,8.044357e-01_rb,&
+        & 8.054275e-01_rb,8.063392e-01_rb,8.071692e-01_rb,8.079157e-01_rb,8.085768e-01_rb,&
+        & 8.091507e-01_rb /)
+      asyice3(:, 29) = (/ &
+! band 29
+        & 8.850026e-01_rb,9.005489e-01_rb,9.069242e-01_rb,9.121799e-01_rb,9.168987e-01_rb,&
+        & 9.212259e-01_rb,9.252176e-01_rb,9.289028e-01_rb,9.323000e-01_rb,9.354235e-01_rb,&
+        & 9.382858e-01_rb,9.408985e-01_rb,9.432734e-01_rb,9.454218e-01_rb,9.473557e-01_rb,&
+        & 9.490871e-01_rb,9.506282e-01_rb,9.519917e-01_rb,9.531904e-01_rb,9.542374e-01_rb,&
+        & 9.551461e-01_rb,9.559298e-01_rb,9.566023e-01_rb,9.571775e-01_rb,9.576692e-01_rb,&
+        & 9.580916e-01_rb,9.584589e-01_rb,9.587853e-01_rb,9.590851e-01_rb,9.593729e-01_rb,&
+        & 9.596632e-01_rb,9.599705e-01_rb,9.603096e-01_rb,9.606954e-01_rb,9.611427e-01_rb,&
+        & 9.616667e-01_rb,9.622826e-01_rb,9.630060e-01_rb,9.638524e-01_rb,9.648379e-01_rb,&
+        & 9.659788e-01_rb,9.672916e-01_rb,9.687933e-01_rb,9.705014e-01_rb,9.724337e-01_rb,&
+        & 9.746084e-01_rb /)
+
+! fdelta: unitless
+      fdlice3(:, 16) = (/ &
+! band 16
+        & 4.959277e-02_rb,4.685292e-02_rb,4.426104e-02_rb,4.181231e-02_rb,3.950191e-02_rb,&
+        & 3.732500e-02_rb,3.527675e-02_rb,3.335235e-02_rb,3.154697e-02_rb,2.985578e-02_rb,&
+        & 2.827395e-02_rb,2.679666e-02_rb,2.541909e-02_rb,2.413640e-02_rb,2.294378e-02_rb,&
+        & 2.183639e-02_rb,2.080940e-02_rb,1.985801e-02_rb,1.897736e-02_rb,1.816265e-02_rb,&
+        & 1.740905e-02_rb,1.671172e-02_rb,1.606585e-02_rb,1.546661e-02_rb,1.490917e-02_rb,&
+        & 1.438870e-02_rb,1.390038e-02_rb,1.343939e-02_rb,1.300089e-02_rb,1.258006e-02_rb,&
+        & 1.217208e-02_rb,1.177212e-02_rb,1.137536e-02_rb,1.097696e-02_rb,1.057210e-02_rb,&
+        & 1.015596e-02_rb,9.723704e-03_rb,9.270516e-03_rb,8.791565e-03_rb,8.282026e-03_rb,&
+        & 7.737072e-03_rb,7.151879e-03_rb,6.521619e-03_rb,5.841467e-03_rb,5.106597e-03_rb,&
+        & 4.312183e-03_rb /)
+      fdlice3(:, 17) = (/ &
+! band 17
+        & 5.071224e-02_rb,5.000217e-02_rb,4.933872e-02_rb,4.871992e-02_rb,4.814380e-02_rb,&
+        & 4.760839e-02_rb,4.711170e-02_rb,4.665177e-02_rb,4.622662e-02_rb,4.583426e-02_rb,&
+        & 4.547274e-02_rb,4.514007e-02_rb,4.483428e-02_rb,4.455340e-02_rb,4.429544e-02_rb,&
+        & 4.405844e-02_rb,4.384041e-02_rb,4.363939e-02_rb,4.345340e-02_rb,4.328047e-02_rb,&
+        & 4.311861e-02_rb,4.296586e-02_rb,4.282024e-02_rb,4.267977e-02_rb,4.254248e-02_rb,&
+        & 4.240640e-02_rb,4.226955e-02_rb,4.212995e-02_rb,4.198564e-02_rb,4.183462e-02_rb,&
+        & 4.167494e-02_rb,4.150462e-02_rb,4.132167e-02_rb,4.112413e-02_rb,4.091003e-02_rb,&
+        & 4.067737e-02_rb,4.042420e-02_rb,4.014854e-02_rb,3.984840e-02_rb,3.952183e-02_rb,&
+        & 3.916683e-02_rb,3.878144e-02_rb,3.836368e-02_rb,3.791158e-02_rb,3.742316e-02_rb,&
+        & 3.689645e-02_rb /)
+      fdlice3(:, 18) = (/ &
+! band 18
+        & 1.062938e-01_rb,1.065234e-01_rb,1.067822e-01_rb,1.070682e-01_rb,1.073793e-01_rb,&
+        & 1.077137e-01_rb,1.080693e-01_rb,1.084442e-01_rb,1.088364e-01_rb,1.092439e-01_rb,&
+        & 1.096647e-01_rb,1.100970e-01_rb,1.105387e-01_rb,1.109878e-01_rb,1.114423e-01_rb,&
+        & 1.119004e-01_rb,1.123599e-01_rb,1.128190e-01_rb,1.132757e-01_rb,1.137279e-01_rb,&
+        & 1.141738e-01_rb,1.146113e-01_rb,1.150385e-01_rb,1.154534e-01_rb,1.158540e-01_rb,&
+        & 1.162383e-01_rb,1.166045e-01_rb,1.169504e-01_rb,1.172741e-01_rb,1.175738e-01_rb,&
+        & 1.178472e-01_rb,1.180926e-01_rb,1.183080e-01_rb,1.184913e-01_rb,1.186405e-01_rb,&
+        & 1.187538e-01_rb,1.188291e-01_rb,1.188645e-01_rb,1.188580e-01_rb,1.188076e-01_rb,&
+        & 1.187113e-01_rb,1.185672e-01_rb,1.183733e-01_rb,1.181277e-01_rb,1.178282e-01_rb,&
+        & 1.174731e-01_rb /)
+      fdlice3(:, 19) = (/ &
+! band 19
+        & 1.076195e-01_rb,1.065195e-01_rb,1.054696e-01_rb,1.044673e-01_rb,1.035099e-01_rb,&
+        & 1.025951e-01_rb,1.017203e-01_rb,1.008831e-01_rb,1.000808e-01_rb,9.931116e-02_rb,&
+        & 9.857151e-02_rb,9.785939e-02_rb,9.717230e-02_rb,9.650774e-02_rb,9.586322e-02_rb,&
+        & 9.523623e-02_rb,9.462427e-02_rb,9.402484e-02_rb,9.343544e-02_rb,9.285358e-02_rb,&
+        & 9.227675e-02_rb,9.170245e-02_rb,9.112818e-02_rb,9.055144e-02_rb,8.996974e-02_rb,&
+        & 8.938056e-02_rb,8.878142e-02_rb,8.816981e-02_rb,8.754323e-02_rb,8.689919e-02_rb,&
+        & 8.623517e-02_rb,8.554869e-02_rb,8.483724e-02_rb,8.409832e-02_rb,8.332943e-02_rb,&
+        & 8.252807e-02_rb,8.169175e-02_rb,8.081795e-02_rb,7.990419e-02_rb,7.894796e-02_rb,&
+        & 7.794676e-02_rb,7.689809e-02_rb,7.579945e-02_rb,7.464834e-02_rb,7.344227e-02_rb,&
+        & 7.217872e-02_rb /)
+      fdlice3(:, 20) = (/ &
+! band 20
+        & 1.119014e-01_rb,1.122706e-01_rb,1.126690e-01_rb,1.130947e-01_rb,1.135456e-01_rb,&
+        & 1.140199e-01_rb,1.145154e-01_rb,1.150302e-01_rb,1.155623e-01_rb,1.161096e-01_rb,&
+        & 1.166703e-01_rb,1.172422e-01_rb,1.178233e-01_rb,1.184118e-01_rb,1.190055e-01_rb,&
+        & 1.196025e-01_rb,1.202008e-01_rb,1.207983e-01_rb,1.213931e-01_rb,1.219832e-01_rb,&
+        & 1.225665e-01_rb,1.231411e-01_rb,1.237050e-01_rb,1.242561e-01_rb,1.247926e-01_rb,&
+        & 1.253122e-01_rb,1.258132e-01_rb,1.262934e-01_rb,1.267509e-01_rb,1.271836e-01_rb,&
+        & 1.275896e-01_rb,1.279669e-01_rb,1.283134e-01_rb,1.286272e-01_rb,1.289063e-01_rb,&
+        & 1.291486e-01_rb,1.293522e-01_rb,1.295150e-01_rb,1.296351e-01_rb,1.297104e-01_rb,&
+        & 1.297390e-01_rb,1.297189e-01_rb,1.296480e-01_rb,1.295244e-01_rb,1.293460e-01_rb,&
+        & 1.291109e-01_rb /)
+      fdlice3(:, 21) = (/ &
+! band 21
+        & 1.133298e-01_rb,1.136777e-01_rb,1.140556e-01_rb,1.144615e-01_rb,1.148934e-01_rb,&
+        & 1.153492e-01_rb,1.158269e-01_rb,1.163243e-01_rb,1.168396e-01_rb,1.173706e-01_rb,&
+        & 1.179152e-01_rb,1.184715e-01_rb,1.190374e-01_rb,1.196108e-01_rb,1.201897e-01_rb,&
+        & 1.207720e-01_rb,1.213558e-01_rb,1.219389e-01_rb,1.225194e-01_rb,1.230951e-01_rb,&
+        & 1.236640e-01_rb,1.242241e-01_rb,1.247733e-01_rb,1.253096e-01_rb,1.258309e-01_rb,&
+        & 1.263352e-01_rb,1.268205e-01_rb,1.272847e-01_rb,1.277257e-01_rb,1.281415e-01_rb,&
+        & 1.285300e-01_rb,1.288893e-01_rb,1.292173e-01_rb,1.295118e-01_rb,1.297710e-01_rb,&
+        & 1.299927e-01_rb,1.301748e-01_rb,1.303154e-01_rb,1.304124e-01_rb,1.304637e-01_rb,&
+        & 1.304673e-01_rb,1.304212e-01_rb,1.303233e-01_rb,1.301715e-01_rb,1.299638e-01_rb,&
+        & 1.296983e-01_rb /)
+      fdlice3(:, 22) = (/ &
+! band 22
+        & 1.145360e-01_rb,1.153256e-01_rb,1.161453e-01_rb,1.169929e-01_rb,1.178666e-01_rb,&
+        & 1.187641e-01_rb,1.196835e-01_rb,1.206227e-01_rb,1.215796e-01_rb,1.225522e-01_rb,&
+        & 1.235383e-01_rb,1.245361e-01_rb,1.255433e-01_rb,1.265579e-01_rb,1.275779e-01_rb,&
+        & 1.286011e-01_rb,1.296257e-01_rb,1.306494e-01_rb,1.316703e-01_rb,1.326862e-01_rb,&
+        & 1.336951e-01_rb,1.346950e-01_rb,1.356838e-01_rb,1.366594e-01_rb,1.376198e-01_rb,&
+        & 1.385629e-01_rb,1.394866e-01_rb,1.403889e-01_rb,1.412678e-01_rb,1.421212e-01_rb,&
+        & 1.429469e-01_rb,1.437430e-01_rb,1.445074e-01_rb,1.452381e-01_rb,1.459329e-01_rb,&
+        & 1.465899e-01_rb,1.472069e-01_rb,1.477819e-01_rb,1.483128e-01_rb,1.487976e-01_rb,&
+        & 1.492343e-01_rb,1.496207e-01_rb,1.499548e-01_rb,1.502346e-01_rb,1.504579e-01_rb,&
+        & 1.506227e-01_rb /)
+      fdlice3(:, 23) = (/ &
+! band 23
+        & 1.153263e-01_rb,1.161445e-01_rb,1.169932e-01_rb,1.178703e-01_rb,1.187738e-01_rb,&
+        & 1.197016e-01_rb,1.206516e-01_rb,1.216217e-01_rb,1.226099e-01_rb,1.236141e-01_rb,&
+        & 1.246322e-01_rb,1.256621e-01_rb,1.267017e-01_rb,1.277491e-01_rb,1.288020e-01_rb,&
+        & 1.298584e-01_rb,1.309163e-01_rb,1.319736e-01_rb,1.330281e-01_rb,1.340778e-01_rb,&
+        & 1.351207e-01_rb,1.361546e-01_rb,1.371775e-01_rb,1.381873e-01_rb,1.391820e-01_rb,&
+        & 1.401593e-01_rb,1.411174e-01_rb,1.420540e-01_rb,1.429671e-01_rb,1.438547e-01_rb,&
+        & 1.447146e-01_rb,1.455449e-01_rb,1.463433e-01_rb,1.471078e-01_rb,1.478364e-01_rb,&
+        & 1.485270e-01_rb,1.491774e-01_rb,1.497857e-01_rb,1.503497e-01_rb,1.508674e-01_rb,&
+        & 1.513367e-01_rb,1.517554e-01_rb,1.521216e-01_rb,1.524332e-01_rb,1.526880e-01_rb,&
+        & 1.528840e-01_rb /)
+      fdlice3(:, 24) = (/ &
+! band 24
+        & 1.160842e-01_rb,1.169118e-01_rb,1.177697e-01_rb,1.186556e-01_rb,1.195676e-01_rb,&
+        & 1.205036e-01_rb,1.214616e-01_rb,1.224394e-01_rb,1.234349e-01_rb,1.244463e-01_rb,&
+        & 1.254712e-01_rb,1.265078e-01_rb,1.275539e-01_rb,1.286075e-01_rb,1.296664e-01_rb,&
+        & 1.307287e-01_rb,1.317923e-01_rb,1.328550e-01_rb,1.339149e-01_rb,1.349699e-01_rb,&
+        & 1.360179e-01_rb,1.370567e-01_rb,1.380845e-01_rb,1.390991e-01_rb,1.400984e-01_rb,&
+        & 1.410803e-01_rb,1.420429e-01_rb,1.429840e-01_rb,1.439016e-01_rb,1.447936e-01_rb,&
+        & 1.456579e-01_rb,1.464925e-01_rb,1.472953e-01_rb,1.480642e-01_rb,1.487972e-01_rb,&
+        & 1.494923e-01_rb,1.501472e-01_rb,1.507601e-01_rb,1.513287e-01_rb,1.518511e-01_rb,&
+        & 1.523252e-01_rb,1.527489e-01_rb,1.531201e-01_rb,1.534368e-01_rb,1.536969e-01_rb,&
+        & 1.538984e-01_rb /)
+      fdlice3(:, 25) = (/ &
+! band 25
+        & 1.168725e-01_rb,1.177088e-01_rb,1.185747e-01_rb,1.194680e-01_rb,1.203867e-01_rb,&
+        & 1.213288e-01_rb,1.222923e-01_rb,1.232750e-01_rb,1.242750e-01_rb,1.252903e-01_rb,&
+        & 1.263187e-01_rb,1.273583e-01_rb,1.284069e-01_rb,1.294626e-01_rb,1.305233e-01_rb,&
+        & 1.315870e-01_rb,1.326517e-01_rb,1.337152e-01_rb,1.347756e-01_rb,1.358308e-01_rb,&
+        & 1.368788e-01_rb,1.379175e-01_rb,1.389449e-01_rb,1.399590e-01_rb,1.409577e-01_rb,&
+        & 1.419389e-01_rb,1.429007e-01_rb,1.438410e-01_rb,1.447577e-01_rb,1.456488e-01_rb,&
+        & 1.465123e-01_rb,1.473461e-01_rb,1.481483e-01_rb,1.489166e-01_rb,1.496492e-01_rb,&
+        & 1.503439e-01_rb,1.509988e-01_rb,1.516118e-01_rb,1.521808e-01_rb,1.527038e-01_rb,&
+        & 1.531788e-01_rb,1.536037e-01_rb,1.539764e-01_rb,1.542951e-01_rb,1.545575e-01_rb,&
+        & 1.547617e-01_rb /)
+      fdlice3(:, 26) = (/ &
+!band 26
+        & 1.180509e-01_rb,1.189025e-01_rb,1.197820e-01_rb,1.206875e-01_rb,1.216171e-01_rb,&
+        & 1.225687e-01_rb,1.235404e-01_rb,1.245303e-01_rb,1.255363e-01_rb,1.265564e-01_rb,&
+        & 1.275888e-01_rb,1.286313e-01_rb,1.296821e-01_rb,1.307392e-01_rb,1.318006e-01_rb,&
+        & 1.328643e-01_rb,1.339284e-01_rb,1.349908e-01_rb,1.360497e-01_rb,1.371029e-01_rb,&
+        & 1.381486e-01_rb,1.391848e-01_rb,1.402095e-01_rb,1.412208e-01_rb,1.422165e-01_rb,&
+        & 1.431949e-01_rb,1.441539e-01_rb,1.450915e-01_rb,1.460058e-01_rb,1.468947e-01_rb,&
+        & 1.477564e-01_rb,1.485888e-01_rb,1.493900e-01_rb,1.501580e-01_rb,1.508907e-01_rb,&
+        & 1.515864e-01_rb,1.522428e-01_rb,1.528582e-01_rb,1.534305e-01_rb,1.539578e-01_rb,&
+        & 1.544380e-01_rb,1.548692e-01_rb,1.552494e-01_rb,1.555767e-01_rb,1.558490e-01_rb,&
+        & 1.560645e-01_rb /)
+      fdlice3(:, 27) = (/ &
+! band 27
+        & 1.200480e-01_rb,1.209267e-01_rb,1.218304e-01_rb,1.227575e-01_rb,1.237059e-01_rb,&
+        & 1.246739e-01_rb,1.256595e-01_rb,1.266610e-01_rb,1.276765e-01_rb,1.287041e-01_rb,&
+        & 1.297420e-01_rb,1.307883e-01_rb,1.318412e-01_rb,1.328988e-01_rb,1.339593e-01_rb,&
+        & 1.350207e-01_rb,1.360813e-01_rb,1.371393e-01_rb,1.381926e-01_rb,1.392396e-01_rb,&
+        & 1.402783e-01_rb,1.413069e-01_rb,1.423235e-01_rb,1.433263e-01_rb,1.443134e-01_rb,&
+        & 1.452830e-01_rb,1.462332e-01_rb,1.471622e-01_rb,1.480681e-01_rb,1.489490e-01_rb,&
+        & 1.498032e-01_rb,1.506286e-01_rb,1.514236e-01_rb,1.521863e-01_rb,1.529147e-01_rb,&
+        & 1.536070e-01_rb,1.542614e-01_rb,1.548761e-01_rb,1.554491e-01_rb,1.559787e-01_rb,&
+        & 1.564629e-01_rb,1.568999e-01_rb,1.572879e-01_rb,1.576249e-01_rb,1.579093e-01_rb,&
+        & 1.581390e-01_rb /)
+      fdlice3(:, 28) = (/ &
+! band 28
+        & 1.247813e-01_rb,1.256496e-01_rb,1.265417e-01_rb,1.274560e-01_rb,1.283905e-01_rb,&
+        & 1.293436e-01_rb,1.303135e-01_rb,1.312983e-01_rb,1.322964e-01_rb,1.333060e-01_rb,&
+        & 1.343252e-01_rb,1.353523e-01_rb,1.363855e-01_rb,1.374231e-01_rb,1.384632e-01_rb,&
+        & 1.395042e-01_rb,1.405441e-01_rb,1.415813e-01_rb,1.426140e-01_rb,1.436404e-01_rb,&
+        & 1.446587e-01_rb,1.456672e-01_rb,1.466640e-01_rb,1.476475e-01_rb,1.486157e-01_rb,&
+        & 1.495671e-01_rb,1.504997e-01_rb,1.514117e-01_rb,1.523016e-01_rb,1.531673e-01_rb,&
+        & 1.540073e-01_rb,1.548197e-01_rb,1.556026e-01_rb,1.563545e-01_rb,1.570734e-01_rb,&
+        & 1.577576e-01_rb,1.584054e-01_rb,1.590149e-01_rb,1.595843e-01_rb,1.601120e-01_rb,&
+        & 1.605962e-01_rb,1.610349e-01_rb,1.614266e-01_rb,1.617693e-01_rb,1.620614e-01_rb,&
+        & 1.623011e-01_rb /)
+      fdlice3(:, 29) = (/ &
+! band 29
+        & 1.006055e-01_rb,9.549582e-02_rb,9.063960e-02_rb,8.602900e-02_rb,8.165612e-02_rb,&
+        & 7.751308e-02_rb,7.359199e-02_rb,6.988496e-02_rb,6.638412e-02_rb,6.308156e-02_rb,&
+        & 5.996942e-02_rb,5.703979e-02_rb,5.428481e-02_rb,5.169657e-02_rb,4.926719e-02_rb,&
+        & 4.698880e-02_rb,4.485349e-02_rb,4.285339e-02_rb,4.098061e-02_rb,3.922727e-02_rb,&
+        & 3.758547e-02_rb,3.604733e-02_rb,3.460497e-02_rb,3.325051e-02_rb,3.197604e-02_rb,&
+        & 3.077369e-02_rb,2.963558e-02_rb,2.855381e-02_rb,2.752050e-02_rb,2.652776e-02_rb,&
+        & 2.556772e-02_rb,2.463247e-02_rb,2.371415e-02_rb,2.280485e-02_rb,2.189670e-02_rb,&
+        & 2.098180e-02_rb,2.005228e-02_rb,1.910024e-02_rb,1.811781e-02_rb,1.709709e-02_rb,&
+        & 1.603020e-02_rb,1.490925e-02_rb,1.372635e-02_rb,1.247363e-02_rb,1.114319e-02_rb,&
+        & 9.727157e-03_rb /)
+
+      end subroutine swcldpr
+
+      end module rrtmg_sw_init
+
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_rad.nomcica.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_rad.nomcica.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_rad.nomcica.f90	(revision 1585)
@@ -0,0 +1,1093 @@
+!     path:      $Source$
+!     author:    $Author: miacono $
+!     revision:  $Revision: 23308 $
+!     created:   $Date: 2013-12-27 17:23:51 -0500 (Fri, 27 Dec 2013) $
+!
+
+       module rrtmg_sw_rad
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+!
+! ****************************************************************************
+! *                                                                          *
+! *                             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                                 *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                                                                          *
+! *                      email:  emlawer@aer.com                             *
+! *                      email:  jdelamer@aer.com                            *
+! *                      email:  miacono@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 parkind, only : im => kind_im, rb => kind_rb
+      use rrsw_vsn
+      use rrtmg_sw_cldprop, only: cldprop_sw
+! *** Move the required call to rrtmg_sw_ini below and the following 
+! use association to GCM initialization area ***
+!      use rrtmg_sw_init, only: rrtmg_sw_ini
+      use rrtmg_sw_setcoef, only: setcoef_sw
+      use rrtmg_sw_spcvrt, only: spcvrt_sw
+
+      implicit none
+
+! public interfaces/functions/subroutines
+      public :: rrtmg_sw, inatm_sw, earth_sun
+
+!------------------------------------------------------------------
+      contains
+!------------------------------------------------------------------
+
+!------------------------------------------------------------------
+! Public subroutines
+!------------------------------------------------------------------
+
+      subroutine rrtmg_sw &
+            (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,cldfr   , &
+             taucld  ,ssacld  ,asmcld  ,fsfcld  , &
+             cicewp  ,cliqwp  ,reice   ,reliq   , &
+             tauaer  ,ssaaer  ,asmaer  ,ecaer   , &
+             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc)
+
+! ------- Description -------
+
+! This program is the driver for RRTMG_SW, the AER SW radiation model for 
+!  application to GCMs, that has been adapted from RRTM_SW for improved
+!  efficiency and to provide fractional cloudiness and cloud overlap
+!  capability using McICA.
+!
+! Note: The call to RRTMG_SW_INI should be moved to the GCM initialization 
+!  area, since this has to be called only once. 
+!
+! This routine
+!    b) calls INATM_SW to read in the atmospheric profile from GCM;
+!       all layering in RRTMG is ordered from surface to toa. 
+!    c) calls CLDPROP_SW to set cloud optical depth based on input
+!       cloud properties
+!    d) calls SETCOEF_SW to calculate various quantities needed for 
+!       the radiative transfer algorithm
+!    e) calls SPCVRT to call the two-stream model that in turn 
+!       calls TAUMOL to calculate gaseous optical depths for each 
+!       of the 16 spectral bands and to perform the radiative transfer;
+!    f) passes the calculated fluxes and cooling rates back to GCM
+!
+! Two modes of operation are possible:
+!     The mode is chosen by using either rrtmg_sw.nomcica.f90 (to not use
+!     McICA) or rrtmg_sw.f90 (to use McICA) to interface with a GCM.
+!
+!    1) Standard, single forward model calculation (imca = 0); this is 
+!       valid only for clear sky or fully overcast clouds
+!    2) Monte Carlo Independent Column Approximation (McICA, Pincus et al., 
+!       JC, 2003) method is applied to the forward model calculation (imca = 1)
+!       This method is valid for clear sky and full or partial cloud conditions.
+!
+! Two methods of cloud property input are possible:
+!     Cloud properties can be input in one of two ways (controlled by input 
+!     flags inflag, iceflag and liqflag; see text file rrtmg_sw_instructions
+!     and subroutine rrtmg_sw_cldprop.f90 for further details):
+!
+!    1) Input cloud fraction, cloud optical depth, single scattering albedo 
+!       and asymmetry parameter directly (inflgsw = 0)
+!    2) Input cloud fraction and cloud physical properties: ice fracion,
+!       ice and liquid particle sizes (inflgsw = 1 or 2);  
+!       cloud optical properties are calculated by cldprop or cldprmc based
+!       on input settings of iceflgsw and liqflgsw
+!
+! Two methods of aerosol property input are possible:
+!     Aerosol properties can be input in one of two ways (controlled by input 
+!     flag iaer, see text file rrtmg_sw_instructions for further details):
+!
+!    1) Input aerosol optical depth, single scattering albedo and asymmetry
+!       parameter directly by layer and spectral band (iaer=10)
+!    2) Input aerosol optical depth and 0.55 micron directly by layer and use
+!       one or more of six ECMWF aerosol types (iaer=6)
+!
+!
+! ------- Modifications -------
+!
+! This version of RRTMG_SW has been modified from RRTM_SW to use a reduced
+! set of g-point intervals and a two-stream model for application to GCMs. 
+!
+!-- Original version (derived from RRTM_SW)
+!     2002: AER. Inc.
+!-- Conversion to F90 formatting; addition of 2-stream radiative transfer
+!     Feb 2003: J.-J. Morcrette, ECMWF
+!-- Additional modifications for GCM application
+!     Aug 2003: M. J. Iacono, AER Inc.
+!-- Total number of g-points reduced from 224 to 112.  Original
+!   set of 224 can be restored by exchanging code in module parrrsw.f90 
+!   and in file rrtmg_sw_init.f90.
+!     Apr 2004: M. J. Iacono, AER, Inc.
+!-- Modifications to include output for direct and diffuse 
+!   downward fluxes.  There are output as "true" fluxes without
+!   any delta scaling applied.  Code can be commented to exclude
+!   this calculation in source file rrtmg_sw_spcvrt.f90.
+!     Jan 2005: E. J. Mlawer, M. J. Iacono, AER, Inc.
+!-- Reformatted for consistency with rrtmg_lw.
+!     Feb 2007: M. J. Iacono, AER, Inc.
+!-- Modifications to formatting to use assumed-shape arrays. 
+!     Aug 2007: M. J. Iacono, AER, Inc.
+!-- Modified to output direct and diffuse fluxes either with or without
+!   delta scaling based on setting of idelm flag. 
+!     Dec 2008: M. J. Iacono, AER, Inc.
+
+! --------- Modules ---------
+
+      use parrrsw, only : nbndsw, ngptsw, naerec, nstr, nmol, mxmol, &
+                          jpband, jpb1, jpb2
+      use rrsw_aer, only : rsrtaua, rsrpiza, rsrasya
+      use rrsw_con, only : heatfac, oneminus, pi
+      use rrsw_wvn, only : wavenum1, wavenum2
+
+! ------- Declarations
+
+! ----- Input -----
+! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
+! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol) 
+      integer(kind=im), intent(in) :: ncol            ! Number of horizontal columns     
+      integer(kind=im), intent(in) :: nlay            ! Number of model layers
+      integer(kind=im), intent(inout) :: icld         ! Cloud overlap method
+                                                      !    0: Clear only
+                                                      !    1: Random
+                                                      !    2: Maximum/random
+                                                      !    3: Maximum
+      integer(kind=im), intent(inout) :: iaer         ! Aerosol option flag
+                                                      !    0: No aerosol
+                                                      !    6: ECMWF method
+                                                      !    10:Input aerosol optical 
+                                                      !       properties
+
+      real(kind=rb), intent(in) :: play(:,:)          ! Layer pressures (hPa, mb)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: plev(:,:)          ! Interface pressures (hPa, mb)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tlay(:,:)          ! Layer temperatures (K)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: tlev(:,:)          ! Interface temperatures (K)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tsfc(:)            ! Surface temperature (K)
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: h2ovmr(:,:)        ! H2O volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o3vmr(:,:)         ! O3 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: co2vmr(:,:)        ! CO2 volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: ch4vmr(:,:)        ! Methane volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: n2ovmr(:,:)        ! Nitrous oxide volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o2vmr(:,:)         ! Oxygen volume mixing ratio
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: asdir(:)           ! UV/vis surface albedo direct rad
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: aldir(:)           ! Near-IR surface albedo direct rad
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: asdif(:)           ! UV/vis surface albedo: diffuse rad
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: aldif(:)           ! Near-IR surface albedo: diffuse rad
+                                                      !    Dimensions: (ncol)
+
+      integer(kind=im), intent(in) :: dyofyr          ! Day of the year (used to get Earth/Sun
+                                                      !  distance if adjflx not provided)
+      real(kind=rb), intent(in) :: adjes              ! Flux adjustment for Earth/Sun distance
+      real(kind=rb), intent(in) :: coszen(:)          ! Cosine of solar zenith angle
+                                                      !    Dimensions: (ncol)
+      real(kind=rb), intent(in) :: scon               ! Solar constant (W/m2)
+
+      integer(kind=im), intent(in) :: inflgsw         ! Flag for cloud optical properties
+      integer(kind=im), intent(in) :: iceflgsw        ! Flag for ice particle specification
+      integer(kind=im), intent(in) :: liqflgsw        ! Flag for liquid droplet specification
+
+      real(kind=rb), intent(in) :: cldfr(:,:)         ! Cloud fraction
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: taucld(:,:,:)      ! In-cloud optical depth
+                                                      !    Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: ssacld(:,:,:)      ! In-cloud single scattering albedo
+                                                      !    Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: asmcld(:,:,:)      ! In-cloud asymmetry parameter
+                                                      !    Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: fsfcld(:,:,:)      ! In-cloud forward scattering fraction
+                                                      !    Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: cicewp(:,:)        ! In-cloud ice water path (g/m2)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cliqwp(:,:)        ! In-cloud liquid water path (g/m2)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: reice(:,:)         ! Cloud ice effective radius (microns)
+                                                      !    Dimensions: (ncol,nlay)
+                                                      ! specific definition of reice depends on setting of iceflgsw:
+                                                      ! iceflgsw = 0: (inactive)
+                                                      !              
+                                                      ! iceflgsw = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
+                                                      !               r_ec range is limited to 13.0 to 130.0 microns
+                                                      ! iceflgsw = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
+                                                      !               r_k range is limited to 5.0 to 131.0 microns
+                                                      ! iceflgsw = 3: generalized effective size, dge, (Fu, 1996),
+                                                      !               dge range is limited to 5.0 to 140.0 microns
+                                                      !               [dge = 1.0315 * r_ec]
+      real(kind=rb), intent(in) :: reliq(:,:)         ! Cloud water drop effective radius (microns)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: tauaer(:,:,:)      ! Aerosol optical depth (iaer=10 only)
+                                                      !    Dimensions: (ncol,nlay,nbndsw)
+                                                      ! (non-delta scaled)      
+      real(kind=rb), intent(in) :: ssaaer(:,:,:)      ! Aerosol single scattering albedo (iaer=10 only)
+                                                      !    Dimensions: (ncol,nlay,nbndsw)
+                                                      ! (non-delta scaled)      
+      real(kind=rb), intent(in) :: asmaer(:,:,:)      ! Aerosol asymmetry parameter (iaer=10 only)
+                                                      !    Dimensions: (ncol,nlay,nbndsw)
+                                                      ! (non-delta scaled)      
+      real(kind=rb), intent(in) :: ecaer(:,:,:)       ! Aerosol optical depth at 0.55 micron (iaer=6 only)
+                                                      !    Dimensions: (ncol,nlay,naerec)
+                                                      ! (non-delta scaled)      
+
+! ----- Output -----
+
+      real(kind=rb), intent(out) :: swuflx(:,:)       ! Total sky shortwave upward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: swdflx(:,:)       ! Total sky shortwave downward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: swhr(:,:)         ! Total sky shortwave radiative heating rate (K/d)
+                                                      !    Dimensions: (ncol,nlay)
+      real(kind=rb), intent(out) :: swuflxc(:,:)      ! Clear sky shortwave upward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: swdflxc(:,:)      ! Clear sky shortwave downward flux (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: swhrc(:,:)        ! Clear sky shortwave radiative heating rate (K/d)
+                                                      !    Dimensions: (ncol,nlay)
+
+! ----- Local -----
+
+! Control
+      integer(kind=im) :: nlayers             ! total number of layers
+      integer(kind=im) :: istart              ! beginning band of calculation
+      integer(kind=im) :: iend                ! ending band of calculation
+      integer(kind=im) :: icpr                ! cldprop/cldprmc use flag
+      integer(kind=im) :: iout                ! output option flag
+      integer(kind=im) :: 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(kind=im) :: isccos              ! instrumental cosine response flag (inactive)
+      integer(kind=im) :: iplon               ! column loop index
+      integer(kind=im) :: i                   ! layer loop index                       ! jk
+      integer(kind=im) :: ib                  ! band loop index                        ! jsw
+      integer(kind=im) :: ia, ig              ! indices
+      integer(kind=im) :: k                   ! layer loop index
+      integer(kind=im) :: ims                 ! value for changing mcica permute seed
+      integer(kind=im) :: imca                ! flag for mcica [0=off, 1=on]
+
+      real(kind=rb) :: zepsec, zepzen         ! epsilon
+      real(kind=rb) :: zdpgcp                 ! flux to heating conversion ratio
+
+! Atmosphere
+      real(kind=rb) :: pavel(nlay+1)          ! layer pressures (mb) 
+      real(kind=rb) :: tavel(nlay+1)          ! layer temperatures (K)
+      real(kind=rb) :: pz(0:nlay+1)           ! level (interface) pressures (hPa, mb)
+      real(kind=rb) :: tz(0:nlay+1)           ! level (interface) temperatures (K)
+      real(kind=rb) :: tbound                 ! surface temperature (K)
+      real(kind=rb) :: pdp(nlay+1)            ! layer pressure thickness (hPa, mb)
+      real(kind=rb) :: coldry(nlay+1)         ! dry air column amount
+      real(kind=rb) :: wkl(mxmol,nlay+1)      ! molecular amounts (mol/cm-2)
+
+!      real(kind=rb) :: earth_sun             ! function for Earth/Sun distance factor
+      real(kind=rb) :: cossza                 ! Cosine of solar zenith angle
+      real(kind=rb) :: adjflux(jpband)        ! adjustment for current Earth/Sun distance
+      real(kind=rb) :: solvar(jpband)         ! solar constant scaling factor from rrtmg_sw
+                                              !  default value of 1368.22 Wm-2 at 1 AU
+      real(kind=rb) :: albdir(nbndsw)         ! surface albedo, direct          ! zalbp
+      real(kind=rb) :: albdif(nbndsw)         ! surface albedo, diffuse         ! zalbd
+
+      real(kind=rb) :: taua(nlay+1,nbndsw)    ! Aerosol optical depth
+      real(kind=rb) :: ssaa(nlay+1,nbndsw)    ! Aerosol single scattering albedo
+      real(kind=rb) :: asma(nlay+1,nbndsw)    ! Aerosol asymmetry parameter
+
+! Atmosphere - setcoef
+      integer(kind=im) :: laytrop             ! tropopause layer index
+      integer(kind=im) :: layswtch            ! tropopause layer index
+      integer(kind=im) :: laylow              ! tropopause layer index
+      integer(kind=im) :: jp(nlay+1)          ! 
+      integer(kind=im) :: jt(nlay+1)          !
+      integer(kind=im) :: jt1(nlay+1)         !
+
+      real(kind=rb) :: colh2o(nlay+1)         ! column amount (h2o)
+      real(kind=rb) :: colco2(nlay+1)         ! column amount (co2)
+      real(kind=rb) :: colo3(nlay+1)          ! column amount (o3)
+      real(kind=rb) :: coln2o(nlay+1)         ! column amount (n2o)
+      real(kind=rb) :: colch4(nlay+1)         ! column amount (ch4)
+      real(kind=rb) :: colo2(nlay+1)          ! column amount (o2)
+      real(kind=rb) :: colmol(nlay+1)         ! column amount
+      real(kind=rb) :: co2mult(nlay+1)        ! column amount 
+
+      integer(kind=im) :: indself(nlay+1)
+      integer(kind=im) :: indfor(nlay+1)
+      real(kind=rb) :: selffac(nlay+1)
+      real(kind=rb) :: selffrac(nlay+1)
+      real(kind=rb) :: forfac(nlay+1)
+      real(kind=rb) :: forfrac(nlay+1)
+
+      real(kind=rb) :: &                      !
+                         fac00(nlay+1), fac01(nlay+1), &
+                         fac10(nlay+1), fac11(nlay+1) 
+
+! Atmosphere/clouds - cldprop
+      integer(kind=im) :: ncbands             ! number of cloud spectral bands
+      integer(kind=im) :: inflag              ! flag for cloud property method
+      integer(kind=im) :: iceflag             ! flag for ice cloud properties
+      integer(kind=im) :: liqflag             ! flag for liquid cloud properties
+
+      real(kind=rb) :: cldfrac(nlay+1)        ! layer cloud fraction
+      real(kind=rb) :: tauc(nbndsw,nlay+1)    ! in-cloud optical depth (non-delta scaled)
+      real(kind=rb) :: ssac(nbndsw,nlay+1)    ! in-cloud single scattering albedo (non-delta scaled)
+      real(kind=rb) :: asmc(nbndsw,nlay+1)    ! in-cloud asymmetry parameter (non-delta scaled)
+      real(kind=rb) :: fsfc(nbndsw,nlay+1)    ! in-cloud forward scattering fraction (non-delta scaled)
+      real(kind=rb) :: ciwp(nlay+1)           ! in-cloud ice water path
+      real(kind=rb) :: clwp(nlay+1)           ! in-cloud liquid water path
+      real(kind=rb) :: rel(nlay+1)            ! cloud liquid particle effective radius (microns)
+      real(kind=rb) :: rei(nlay+1)            ! cloud ice particle effective size (microns)
+
+      real(kind=rb) :: taucloud(nlay+1,jpband)  ! in-cloud optical depth
+      real(kind=rb) :: taucldorig(nlay+1,jpband)! in-cloud optical depth (non-delta scaled)
+      real(kind=rb) :: ssacloud(nlay+1,jpband)  ! in-cloud single scattering albedo
+      real(kind=rb) :: asmcloud(nlay+1,jpband)  ! in-cloud asymmetry parameter
+
+! Atmosphere/clouds/aerosol - spcvrt,spcvmc
+      real(kind=rb) :: ztauc(nlay+1,nbndsw)     ! cloud optical depth
+      real(kind=rb) :: ztaucorig(nlay+1,nbndsw) ! unscaled cloud optical depth
+      real(kind=rb) :: zasyc(nlay+1,nbndsw)     ! cloud asymmetry parameter 
+                                                !  (first moment of phase function)
+      real(kind=rb) :: zomgc(nlay+1,nbndsw)     ! cloud single scattering albedo
+      real(kind=rb) :: ztaua(nlay+1,nbndsw)     ! total aerosol optical depth
+      real(kind=rb) :: zasya(nlay+1,nbndsw)     ! total aerosol asymmetry parameter 
+      real(kind=rb) :: zomga(nlay+1,nbndsw)     ! total aerosol single scattering albedo
+
+      real(kind=rb) :: zbbfu(nlay+2)          ! temporary upward shortwave flux (w/m2)
+      real(kind=rb) :: zbbfd(nlay+2)          ! temporary downward shortwave flux (w/m2)
+      real(kind=rb) :: zbbcu(nlay+2)          ! temporary clear sky upward shortwave flux (w/m2)
+      real(kind=rb) :: zbbcd(nlay+2)          ! temporary clear sky downward shortwave flux (w/m2)
+      real(kind=rb) :: zbbfddir(nlay+2)       ! temporary downward direct shortwave flux (w/m2)
+      real(kind=rb) :: zbbcddir(nlay+2)       ! temporary clear sky downward direct shortwave flux (w/m2)
+      real(kind=rb) :: zuvfd(nlay+2)          ! temporary UV downward shortwave flux (w/m2)
+      real(kind=rb) :: zuvcd(nlay+2)          ! temporary clear sky UV downward shortwave flux (w/m2)
+      real(kind=rb) :: zuvfddir(nlay+2)       ! temporary UV downward direct shortwave flux (w/m2)
+      real(kind=rb) :: zuvcddir(nlay+2)       ! temporary clear sky UV downward direct shortwave flux (w/m2)
+      real(kind=rb) :: znifd(nlay+2)          ! temporary near-IR downward shortwave flux (w/m2)
+      real(kind=rb) :: znicd(nlay+2)          ! temporary clear sky near-IR downward shortwave flux (w/m2)
+      real(kind=rb) :: znifddir(nlay+2)       ! temporary near-IR downward direct shortwave flux (w/m2)
+      real(kind=rb) :: znicddir(nlay+2)       ! temporary clear sky near-IR downward direct shortwave flux (w/m2)
+
+! Optional output fields 
+      real(kind=rb) :: swnflx(nlay+2)         ! Total sky shortwave net flux (W/m2)
+      real(kind=rb) :: swnflxc(nlay+2)        ! Clear sky shortwave net flux (W/m2)
+      real(kind=rb) :: dirdflux(nlay+2)       ! Direct downward shortwave surface flux
+      real(kind=rb) :: difdflux(nlay+2)       ! Diffuse downward shortwave surface flux
+      real(kind=rb) :: uvdflx(nlay+2)         ! Total sky downward shortwave flux, UV/vis  
+      real(kind=rb) :: nidflx(nlay+2)         ! Total sky downward shortwave flux, near-IR 
+      real(kind=rb) :: dirdnuv(nlay+2)        ! Direct downward shortwave flux, UV/vis
+      real(kind=rb) :: difdnuv(nlay+2)        ! Diffuse downward shortwave flux, UV/vis
+      real(kind=rb) :: dirdnir(nlay+2)        ! Direct downward shortwave flux, near-IR
+      real(kind=rb) :: difdnir(nlay+2)        ! Diffuse downward shortwave flux, near-IR
+
+! Output - inactive
+!      real(kind=rb) :: zuvfu(nlay+2)         ! temporary upward UV shortwave flux (w/m2)
+!      real(kind=rb) :: zuvfd(nlay+2)         ! temporary downward UV shortwave flux (w/m2)
+!      real(kind=rb) :: zuvcu(nlay+2)         ! temporary clear sky upward UV shortwave flux (w/m2)
+!      real(kind=rb) :: zuvcd(nlay+2)         ! temporary clear sky downward UV shortwave flux (w/m2)
+!      real(kind=rb) :: zvsfu(nlay+2)         ! temporary upward visible shortwave flux (w/m2)
+!      real(kind=rb) :: zvsfd(nlay+2)         ! temporary downward visible shortwave flux (w/m2)
+!      real(kind=rb) :: zvscu(nlay+2)         ! temporary clear sky upward visible shortwave flux (w/m2)
+!      real(kind=rb) :: zvscd(nlay+2)         ! temporary clear sky downward visible shortwave flux (w/m2)
+!      real(kind=rb) :: znifu(nlay+2)         ! temporary upward near-IR shortwave flux (w/m2)
+!      real(kind=rb) :: znifd(nlay+2)         ! temporary downward near-IR shortwave flux (w/m2)
+!      real(kind=rb) :: znicu(nlay+2)         ! temporary clear sky upward near-IR shortwave flux (w/m2)
+!      real(kind=rb) :: znicd(nlay+2)         ! temporary clear sky downward near-IR shortwave flux (w/m2)
+
+
+! Initializations
+
+      zepsec = 1.e-06_rb
+      zepzen = 1.e-10_rb
+      oneminus = 1.0_rb - zepsec
+      pi = 2._rb * asin(1._rb)
+
+      istart = jpb1
+      iend = jpb2
+      iout = 0
+      icpr = 0
+
+! In a GCM with or without McICA, set nlon to the longitude dimension
+!
+! Set imca to select calculation type:
+!  imca = 0, use standard forward model calculation (clear and overcast only)
+!  imca = 1, use McICA for Monte Carlo treatment of sub-grid cloud variability
+!            (clear, overcast or partial cloud conditions)
+
+! *** This version does not use McICA (imca = 0) ***
+
+! Set icld to select of clear or cloud calculation and cloud 
+! overlap method (read by subroutine readprof from input file INPUT_RRTM):  
+! Without McICA, SW calculation is limited to clear or fully overcast conditions. 
+! icld = 0, clear only
+! icld = 1, with clouds using random cloud overlap (McICA only)
+! icld = 2, with clouds using maximum/random cloud overlap (McICA only)
+! icld = 3, with clouds using maximum cloud overlap (McICA only)
+      if (icld.lt.0.or.icld.gt.3) icld = 2
+
+! Set iaer to select aerosol option
+! iaer = 0, no aerosols
+! iaer = 6, use six ECMWF aerosol types
+!           input aerosol optical depth at 0.55 microns for each aerosol type (ecaer)
+! iaer = 10, input total aerosol optical depth, single scattering albedo 
+!            and asymmetry parameter (tauaer, ssaaer, asmaer) directly
+      if (iaer.ne.0.and.iaer.ne.6.and.iaer.ne.10) iaer = 0
+
+! Set idelm to select between delta-M scaled or unscaled output direct and diffuse fluxes
+! NOTE: total downward fluxes are always delta scaled
+! idelm = 0, output direct and diffuse flux components are not delta scaled
+!            (direct flux does not include forward scattering peak)
+! idelm = 1, output direct and diffuse flux components are delta scaled (default)
+!            (direct flux includes part or most of forward scattering peak)
+      idelm = 1
+
+! Call model and data initialization, compute lookup tables, perform
+! reduction of g-points from 224 to 112 for input absorption
+! coefficient data and other arrays.
+!
+! In a GCM this call should be placed in the model initialization
+! area, since this has to be called only once.  
+!      call rrtmg_sw_ini(cpdair)
+
+! This is the main longitude/column loop in RRTMG.
+! Modify to loop over all columns (nlon) or over daylight columns
+
+      do iplon = 1, ncol
+
+! Prepare atmosphere profile from GCM for use in RRTMG, and define
+! other input parameters
+
+         call inatm_sw (iplon, nlay, icld, iaer, &
+              play, plev, tlay, tlev, tsfc, h2ovmr, &
+              o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, &
+              adjes, dyofyr, scon, inflgsw, iceflgsw, liqflgsw, &
+              cldfr, taucld, ssacld, asmcld, fsfcld, cicewp, cliqwp, &
+              reice, reliq, tauaer, ssaaer, asmaer, &
+              nlayers, pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, &
+              adjflux, solvar, inflag, iceflag, liqflag, cldfrac, tauc, &
+              ssac, asmc, fsfc, ciwp, clwp, rei, rel, taua, ssaa, asma)
+
+!  For cloudy atmosphere, use cldprop to set cloud optical properties based on
+!  input cloud physical properties.  Select method based on choices described
+!  in cldprop.  Cloud fraction, water path, liquid droplet and ice particle
+!  effective radius must be passed in cldprop.  Cloud fraction and cloud
+!  optical properties are transferred to rrtmg_sw arrays in cldprop.  
+
+!  Without McICA, SW calculation is limited to clear or fully overcast conditions. 
+!  Stop model if partial cloudiness is present.  
+
+         do i = 1, nlayers
+            if (cldfrac(i).gt.zepsec .and. cldfrac(i).lt.oneminus) then
+               stop 'PARTIAL CLOUD NOT ALLOWED'
+            endif
+         enddo
+         call cldprop_sw(nlayers, inflag, iceflag, liqflag, cldfrac, &
+                         tauc, ssac, asmc, fsfc, ciwp, clwp, rei, rel, &
+                         taucldorig, taucloud, ssacloud, asmcloud)
+         icpr = 1
+
+! Calculate coefficients for the temperature and pressure dependence of the 
+! molecular absorption coefficients by interpolating data from stored
+! reference atmospheres.
+
+         call setcoef_sw(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)
+
+
+! Cosine of the solar zenith angle 
+!  Prevent using value of zero; ideally, SW model is not called from host model when sun 
+!  is below horizon
+
+         cossza = coszen(iplon)
+         if (cossza .lt. zepzen) cossza = zepzen
+
+
+! Transfer albedo, cloud and aerosol properties into arrays for 2-stream radiative transfer 
+
+! Surface albedo
+!  Near-IR bands 16-24 and 29 (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns
+         do ib=1,9
+            albdir(ib) = aldir(iplon)
+            albdif(ib) = aldif(iplon)
+         enddo
+         albdir(nbndsw) = aldir(iplon)
+         albdif(nbndsw) = aldif(iplon)
+!  UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron
+         do ib=10,13
+            albdir(ib) = asdir(iplon)
+            albdif(ib) = asdif(iplon)
+         enddo
+
+
+! Clouds
+         if (icld.eq.0) then
+
+            ztauc(:,:) = 0._rb
+            ztaucorig(:,:) = 0._rb
+            zasyc(:,:) = 0._rb
+            zomgc(:,:) = 1._rb
+
+         elseif (icld.ge.1) then
+            do i=1,nlayers
+               do ib=1,nbndsw
+                  ztauc(i,ib) = taucloud(i,jpb1-1+ib)
+                  ztaucorig(i,ib) = taucldorig(i,jpb1-1+ib)
+                  zasyc(i,ib) = asmcloud(i,jpb1-1+ib)
+                  zomgc(i,ib) = ssacloud(i,jpb1-1+ib)
+               enddo
+            enddo
+
+         endif   
+
+! Aerosol
+! IAER = 0: no aerosols
+         if (iaer.eq.0) then
+
+            ztaua(:,:) = 0._rb
+            zasya(:,:) = 0._rb
+            zomga(:,:) = 1._rb
+
+! IAER = 6: Use ECMWF six aerosol types. See rrsw_aer.f90 for details.
+! Input aerosol optical thickness at 0.55 micron for each aerosol type (ecaer), 
+! or set manually here for each aerosol and layer.
+         elseif (iaer.eq.6) then
+
+!            do i = 1, nlayers
+!               do ia = 1, naerec
+!                  ecaer(iplon,i,ia) = 1.0e-15_rb
+!               enddo
+!            enddo
+
+            do i = 1, nlayers
+               do ib = 1, nbndsw
+                  ztaua(i,ib) = 0._rb
+                  zasya(i,ib) = 0._rb
+                  zomga(i,ib) = 0._rb
+                  do ia = 1, naerec
+                     ztaua(i,ib) = ztaua(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia)
+                     zomga(i,ib) = zomga(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia) * &
+                                   rsrpiza(ib,ia)
+                     zasya(i,ib) = zasya(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia) * &
+                                   rsrpiza(ib,ia) * rsrasya(ib,ia)
+                  enddo
+                  if (ztaua(i,ib) == 0._rb) then
+                     ztaua(i,ib) = 0._rb
+                     zasya(i,ib) = 0._rb
+                     zomga(i,ib) = 1._rb
+                  else
+                     if (zomga(i,ib) /= 0._rb) then
+                        zasya(i,ib) = zasya(i,ib) / zomga(i,ib)
+                     endif
+                     if (ztaua(i,ib) /= 0._rb) then
+                        zomga(i,ib) = zomga(i,ib) / ztaua(i,ib)
+                     endif
+                  endif
+               enddo
+            enddo
+
+! IAER=10: Direct specification of aerosol optical properties from GCM
+         elseif (iaer.eq.10) then
+
+            do i = 1 ,nlayers
+               do ib = 1 ,nbndsw
+                  ztaua(i,ib) = taua(i,ib)
+                  zasya(i,ib) = asma(i,ib)
+                  zomga(i,ib) = ssaa(i,ib)
+               enddo
+            enddo
+
+         endif
+
+
+! Call the 2-stream radiation transfer model
+
+         do i=1,nlayers+1
+            zbbcu(i) = 0._rb
+            zbbcd(i) = 0._rb
+            zbbfu(i) = 0._rb
+            zbbfd(i) = 0._rb
+            zbbcddir(i) = 0._rb
+            zbbfddir(i) = 0._rb
+            zuvcd(i) = 0._rb
+            zuvfd(i) = 0._rb
+            zuvcddir(i) = 0._rb
+            zuvfddir(i) = 0._rb
+            znicd(i) = 0._rb
+            znifd(i) = 0._rb
+            znicddir(i) = 0._rb
+            znifddir(i) = 0._rb
+         enddo
+
+         call spcvrt_sw &
+             (nlayers, istart, iend, icpr, idelm, iout, &
+              pavel, tavel, pz, tz, tbound, albdif, albdir, &
+              cldfrac, ztauc, zasyc, zomgc, ztaucorig, &
+              ztaua, zasya, zomga, cossza, coldry, wkl, 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)
+
+! 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.
+
+         do i = 1, nlayers+1
+            swuflxc(iplon,i) = zbbcu(i)
+            swdflxc(iplon,i) = zbbcd(i)
+            swuflx(iplon,i) = zbbfu(i)
+            swdflx(iplon,i) = zbbfd(i)
+            uvdflx(i) = zuvfd(i)
+            nidflx(i) = znifd(i)
+!  Direct/diffuse fluxes
+            dirdflux(i) = zbbfddir(i)
+            difdflux(i) = swdflx(iplon,i) - dirdflux(i)
+!  UV/visible direct/diffuse fluxes
+            dirdnuv(i) = zuvfddir(i)
+            difdnuv(i) = zuvfd(i) - dirdnuv(i)
+!  Near-IR direct/diffuse fluxes
+            dirdnir(i) = znifddir(i)
+            difdnir(i) = znifd(i) - dirdnir(i)
+         enddo
+
+!  Total and clear sky net fluxes
+         do i = 1, nlayers+1
+            swnflxc(i) = swdflxc(iplon,i) - swuflxc(iplon,i)
+            swnflx(i) = swdflx(iplon,i) - swuflx(iplon,i)
+         enddo
+
+!  Total and clear sky heating rates
+         do i = 1, nlayers
+            zdpgcp = heatfac / pdp(i)
+            swhrc(iplon,i) = (swnflxc(i+1) - swnflxc(i)) * zdpgcp
+            swhr(iplon,i) = (swnflx(i+1) - swnflx(i)) * zdpgcp
+         enddo
+         swhrc(iplon,nlayers) = 0._rb
+         swhr(iplon,nlayers) = 0._rb
+
+! End longitude loop
+      enddo
+
+      end subroutine rrtmg_sw
+
+!*************************************************************************
+      real(kind=rb) 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, only : pi
+
+      integer(kind=im), intent(in) :: idn
+
+      real(kind=rb) :: gamma
+
+      gamma = 2._rb*pi*(idn-1)/365._rb
+
+! Use Iqbal's equation 1.2.1
+
+      earth_sun = 1.000110_rb + .034221_rb * cos(gamma) + .001289_rb * sin(gamma) + &
+                   .000719_rb * cos(2._rb*gamma) + .000077_rb * sin(2._rb*gamma)
+
+      end function earth_sun
+
+!***************************************************************************
+      subroutine inatm_sw (iplon, nlay, icld, iaer, &
+            play, plev, tlay, tlev, tsfc, h2ovmr, &
+            o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, &
+            adjes, dyofyr, scon, inflgsw, iceflgsw, liqflgsw, &
+            cldfr, taucld, ssacld, asmcld, fsfcld, cicewp, cliqwp, &
+            reice, reliq, tauaer, ssaaer, asmaer, &
+            nlayers, pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, &
+            adjflux, solvar, inflag, iceflag, liqflag, cldfrac, tauc, &
+            ssac, asmc, fsfc, ciwp, clwp, rei, rel, taua, ssaa, asma)
+!***************************************************************************
+!
+!  Input atmospheric profile from GCM, and prepare it for use in RRTMG_SW.
+!  Set other RRTMG_SW input parameters.  
+!
+!***************************************************************************
+
+! --------- Modules ----------
+
+      use parrrsw, only : nbndsw, ngptsw, nstr, nmol, mxmol, &
+                          jpband, jpb1, jpb2, rrsw_scon
+      use rrsw_con, only : fluxfac, heatfac, oneminus, pi, grav, avogad
+      use rrsw_wvn, only : ng, nspa, nspb, wavenum1, wavenum2, delwave
+
+! ------- Declarations -------
+
+! ----- Input -----
+! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
+! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol) 
+      integer(kind=im), intent(in) :: iplon           ! column loop index
+      integer(kind=im), intent(in) :: nlay            ! number of model layers
+      integer(kind=im), intent(in) :: icld            ! clear/cloud flag
+      integer(kind=im), intent(in) :: iaer            ! aerosol option flag
+
+      real(kind=rb), intent(in) :: play(:,:)          ! Layer pressures (hPa, mb)
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: plev(:,:)          ! Interface pressures (hPa, mb)
+                                                      ! Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tlay(:,:)          ! Layer temperatures (K)
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: tlev(:,:)          ! Interface temperatures (K)
+                                                      ! Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(in) :: tsfc(:)            ! Surface temperature (K)
+                                                      ! Dimensions: (ncol)
+      real(kind=rb), intent(in) :: h2ovmr(:,:)        ! H2O volume mixing ratio
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o3vmr(:,:)         ! O3 volume mixing ratio
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: co2vmr(:,:)        ! CO2 volume mixing ratio
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: ch4vmr(:,:)        ! Methane volume mixing ratio
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: n2ovmr(:,:)        ! Nitrous oxide volume mixing ratio
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: o2vmr(:,:)         ! Oxygen volume mixing ratio
+                                                      ! Dimensions: (ncol,nlay)
+
+      integer(kind=im), intent(in) :: dyofyr          ! Day of the year (used to get Earth/Sun
+                                                      !  distance if adjflx not provided)
+      real(kind=rb), intent(in) :: adjes              ! Flux adjustment for Earth/Sun distance
+      real(kind=rb), intent(in) :: scon               ! Solar constant (W/m2)
+
+      integer(kind=im), intent(in) :: inflgsw         ! Flag for cloud optical properties
+      integer(kind=im), intent(in) :: iceflgsw        ! Flag for ice particle specification
+      integer(kind=im), intent(in) :: liqflgsw        ! Flag for liquid droplet specification
+
+      real(kind=rb), intent(in) :: cldfr(:,:)         ! Cloud fraction
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: taucld(:,:,:)      ! In-cloud optical depth (optional)
+                                                      ! Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: ssacld(:,:,:)      ! In-cloud single scattering albedo
+                                                      ! Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: asmcld(:,:,:)      ! In-cloud asymmetry parameter
+                                                      ! Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: fsfcld(:,:,:)      ! In-cloud forward scattering fraction
+                                                      ! Dimensions: (nbndsw,ncol,nlay)
+      real(kind=rb), intent(in) :: cicewp(:,:)        ! In-cloud ice water path (g/m2)
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: cliqwp(:,:)        ! In-cloud liquid water path (g/m2)
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: reice(:,:)         ! Cloud ice effective size (microns)
+                                                      ! Dimensions: (ncol,nlay)
+      real(kind=rb), intent(in) :: reliq(:,:)         ! Cloud water drop effective radius (microns)
+                                                      ! Dimensions: (ncol,nlay)
+
+      real(kind=rb), intent(in) :: tauaer(:,:,:)      ! Aerosol optical depth
+                                                      ! Dimensions: (ncol,nlay,nbndsw)
+      real(kind=rb), intent(in) :: ssaaer(:,:,:)      ! Aerosol single scattering albedo
+                                                      ! Dimensions: (ncol,nlay,nbndsw)
+      real(kind=rb), intent(in) :: asmaer(:,:,:)      ! Aerosol asymmetry parameter
+                                                      ! Dimensions: (ncol,nlay,nbndsw)
+
+! Atmosphere
+      integer(kind=im), intent(out) :: nlayers        ! number of layers
+
+      real(kind=rb), intent(out) :: pavel(:)          ! layer pressures (mb) 
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: tavel(:)          ! layer temperatures (K)
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: pz(0:)            ! level (interface) pressures (hPa, mb)
+                                                      ! Dimensions: (0:nlay)
+      real(kind=rb), intent(out) :: tz(0:)            ! level (interface) temperatures (K)
+                                                      ! Dimensions: (0:nlay)
+      real(kind=rb), intent(out) :: tbound            ! surface temperature (K)
+      real(kind=rb), intent(out) :: pdp(:)            ! layer pressure thickness (hPa, mb)
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: coldry(:)         ! dry air column density (mol/cm2)
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: wkl(:,:)          ! molecular amounts (mol/cm-2)
+                                                      ! Dimensions: (mxmol,nlay)
+
+      real(kind=rb), intent(out) :: adjflux(:)        ! adjustment for current Earth/Sun distance
+                                                      ! Dimensions: (jpband)
+      real(kind=rb), intent(out) :: solvar(:)         ! solar constant scaling factor from rrtmg_sw
+                                                      ! Dimensions: (jpband)
+                                                      !  default value of 1368.22 Wm-2 at 1 AU
+      real(kind=rb), intent(out) :: taua(:,:)         ! Aerosol optical depth
+                                                      ! Dimensions: (nlay,nbndsw)
+      real(kind=rb), intent(out) :: ssaa(:,:)         ! Aerosol single scattering albedo
+                                                      ! Dimensions: (nlay,nbndsw)
+      real(kind=rb), intent(out) :: asma(:,:)         ! Aerosol asymmetry parameter
+                                                      ! Dimensions: (nlay,nbndsw)
+
+! Atmosphere/clouds - cldprop
+      integer(kind=im), intent(out) :: inflag         ! flag for cloud property method
+      integer(kind=im), intent(out) :: iceflag        ! flag for ice cloud properties
+      integer(kind=im), intent(out) :: liqflag        ! flag for liquid cloud properties
+
+      real(kind=rb), intent(out) :: cldfrac(:)        ! layer cloud fraction
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: tauc(:,:)         ! in-cloud optical depth (non-delta scaled)
+                                                      ! Dimensions: (nbndsw,nlay)
+      real(kind=rb), intent(out) :: ssac(:,:)         ! in-cloud single scattering albedo (non-delta-scaled)
+                                                      ! Dimensions: (nbndsw,nlay)
+      real(kind=rb), intent(out) :: asmc(:,:)         ! in-cloud asymmetry parameter (non-delta scaled)
+                                                      ! Dimensions: (nbndsw,nlay)
+      real(kind=rb), intent(out) :: fsfc(:,:)         ! in-cloud forward scattering fraction (non-delta scaled)
+                                                      ! Dimensions: (nbndsw,nlay)
+      real(kind=rb), intent(out) :: ciwp(:)           ! in-cloud ice water path
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: clwp(:)           ! in-cloud liquid water path
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: rel(:)            ! cloud liquid particle effective radius (microns)
+                                                      ! Dimensions: (nlay)
+      real(kind=rb), intent(out) :: rei(:)            ! cloud ice particle effective size (microns)
+                                                      ! Dimensions: (nlay)
+
+! ----- Local -----
+      real(kind=rb), parameter :: amd = 28.9660_rb    ! Effective molecular weight of dry air (g/mol)
+      real(kind=rb), parameter :: amw = 18.0160_rb    ! Molecular weight of water vapor (g/mol)
+!      real(kind=rb), parameter :: amc = 44.0098_rb   ! Molecular weight of carbon dioxide (g/mol)
+!      real(kind=rb), parameter :: amo = 47.9998_rb   ! Molecular weight of ozone (g/mol)
+!      real(kind=rb), parameter :: amo2 = 31.9999_rb  ! Molecular weight of oxygen (g/mol)
+!      real(kind=rb), parameter :: amch4 = 16.0430_rb ! Molecular weight of methane (g/mol)
+!      real(kind=rb), parameter :: amn2o = 44.0128_rb ! Molecular weight of nitrous oxide (g/mol)
+
+! Set molecular weight ratios (for converting mmr to vmr)
+!  e.g. h2ovmr = h2ommr * amdw)
+      real(kind=rb), parameter :: amdw = 1.607793_rb  ! Molecular weight of dry air / water vapor
+      real(kind=rb), parameter :: amdc = 0.658114_rb  ! Molecular weight of dry air / carbon dioxide
+      real(kind=rb), parameter :: amdo = 0.603428_rb  ! Molecular weight of dry air / ozone
+      real(kind=rb), parameter :: amdm = 1.805423_rb  ! Molecular weight of dry air / methane
+      real(kind=rb), parameter :: amdn = 0.658090_rb  ! Molecular weight of dry air / nitrous oxide
+      real(kind=rb), parameter :: amdo2 = 0.905140_rb ! Molecular weight of dry air / oxygen
+
+      real(kind=rb), parameter :: sbc = 5.67e-08_rb   ! Stefan-Boltzmann constant (W/m2K4)
+
+      integer(kind=im) :: isp, l, ix, n, imol, ib       ! Loop indices
+      real(kind=rb) :: amm, summol                      ! 
+      real(kind=rb) :: adjflx                           ! flux adjustment for Earth/Sun distance
+!      real(kind=rb) :: earth_sun                        ! function for Earth/Sun distance adjustment
+
+! Add one to nlayers here to include extra model layer at top of atmosphere
+      nlayers = nlay
+
+!  Initialize all molecular amounts to zero here, then pass input amounts
+!  into RRTM array WKL below.
+
+      wkl(:,:) = 0.0_rb
+      cldfrac(:) = 0.0_rb
+      tauc(:,:) = 0.0_rb
+      ssac(:,:) = 1.0_rb
+      asmc(:,:) = 0.0_rb
+      fsfc(:,:) = 0.0_rb
+      ciwp(:) = 0.0_rb
+      clwp(:) = 0.0_rb
+      rei(:) = 0.0_rb
+      rel(:) = 0.0_rb
+      taua(:,:) = 0.0_rb
+      ssaa(:,:) = 1.0_rb
+      asma(:,:) = 0.0_rb
+ 
+! Set flux adjustment for current Earth/Sun distance (two options).
+! 1) Use Earth/Sun distance flux adjustment provided by GCM (input as adjes);
+      adjflx = adjes
+!
+! 2) Calculate Earth/Sun distance from DYOFYR, the cumulative day of the year.
+!    (Set adjflx to 1. to use constant Earth/Sun distance of 1 AU). 
+      if (dyofyr .gt. 0) then
+         adjflx = earth_sun(dyofyr)
+      endif
+
+! Set incoming solar flux adjustment to include adjustment for
+! current Earth/Sun distance (ADJFLX) and scaling of default internal
+! solar constant (rrsw_scon = 1368.22 Wm-2) by band (SOLVAR).  SOLVAR can be set 
+! to a single scaling factor as needed, or to a different value in each 
+! band, which may be necessary for paleoclimate simulations. 
+! 
+      do ib = jpb1,jpb2
+!         solvar(ib) = 1._rb
+         solvar(ib) = scon / rrsw_scon
+         adjflux(ib) = adjflx * solvar(ib)
+      enddo
+
+!  Set surface temperature.
+      tbound = tsfc(iplon)
+
+!  Install input GCM arrays into RRTMG_SW arrays for pressure, temperature,
+!  and molecular amounts.  
+!  Pressures are input in mb, or are converted to mb here.
+!  Molecular amounts are input in volume mixing ratio, or are converted from 
+!  mass mixing ratio (or specific humidity for h2o) to volume mixing ratio
+!  here. These are then converted to molecular amount (molec/cm2) below.  
+!  The dry air column COLDRY (in molec/cm2) is calculated from the level 
+!  pressures, pz (in mb), based on the hydrostatic equation and includes a 
+!  correction to account for h2o in the layer.  The molecular weight of moist 
+!  air (amm) is calculated for each layer.  
+!  Note: In RRTMG, layer indexing goes from bottom to top, and coding below
+!  assumes GCM input fields are also bottom to top. Input layer indexing
+!  from GCM fields should be reversed here if necessary.
+
+      pz(0) = plev(iplon,1)
+      tz(0) = tlev(iplon,1)
+      do l = 1, nlayers
+         pavel(l) = play(iplon,l)
+         tavel(l) = tlay(iplon,l)
+         pz(l) = plev(iplon,l+1)
+         tz(l) = tlev(iplon,l+1)
+         pdp(l) = pz(l-1) - pz(l)
+! For h2o input in vmr:
+         wkl(1,l) = h2ovmr(iplon,l)
+! For h2o input in mmr:
+!         wkl(1,l) = h2o(iplon,l)*amdw
+! For h2o input in specific humidity;
+!         wkl(1,l) = (h2o(iplon,l)/(1._rb - h2o(iplon,l)))*amdw
+         wkl(2,l) = co2vmr(iplon,l)
+         wkl(3,l) = o3vmr(iplon,l)
+         wkl(4,l) = n2ovmr(iplon,l)
+         wkl(6,l) = ch4vmr(iplon,l)
+         wkl(7,l) = o2vmr(iplon,l)
+         amm = (1._rb - wkl(1,l)) * amd + wkl(1,l) * amw            
+         coldry(l) = (pz(l-1)-pz(l)) * 1.e3_rb * avogad / &
+                     (1.e2_rb * grav * amm * (1._rb + wkl(1,l)))
+      enddo
+
+! The following section can be used to set values for an additional layer (from
+! the GCM top level to 1.e-4 mb) for improved calculation of TOA fluxes. 
+! Temperature and molecular amounts in the extra model layer are set to 
+! their values in the top GCM model layer, though these can be modified
+! here if necessary. 
+! If this feature is utilized, increase nlayers by one above, limit the two
+! loops above to (nlayers-1), and set the top most (nlayers) layer values here. 
+
+!      pavel(nlayers) = 0.5_rb * pz(nlayers-1)
+!      tavel(nlayers) = tavel(nlayers-1)
+!      pz(nlayers) = 1.e-4_rb
+!      tz(nlayers-1) = 0.5_rb * (tavel(nlayers)+tavel(nlayers-1))
+!      tz(nlayers) = tz(nlayers-1)
+!      pdp(nlayers) = pz(nlayers-1) - pz(nlayers)
+!      wkl(1,nlayers) = wkl(1,nlayers-1)
+!      wkl(2,nlayers) = wkl(2,nlayers-1)
+!      wkl(3,nlayers) = wkl(3,nlayers-1)
+!      wkl(4,nlayers) = wkl(4,nlayers-1)
+!      wkl(6,nlayers) = wkl(6,nlayers-1)
+!      wkl(7,nlayers) = wkl(7,nlayers-1)
+!      amm = (1._rb - wkl(1,nlayers-1)) * amd + wkl(1,nlayers-1) * amw
+!      coldry(nlayers) = (pz(nlayers-1)) * 1.e3_rb * avogad / &
+!                        (1.e2_rb * grav * amm * (1._rb + wkl(1,nlayers-1)))
+
+! At this point all molecular amounts in wkl are in volume mixing ratio; 
+! convert to molec/cm2 based on coldry for use in rrtm.  
+
+      do l = 1, nlayers
+         do imol = 1, nmol
+            wkl(imol,l) = coldry(l) * wkl(imol,l)
+         enddo
+      enddo
+
+! Transfer aerosol optical properties to RRTM variables;
+! modify to reverse layer indexing here if necessary.
+
+      if (iaer .ge. 1) then 
+         do l = 1, nlayers
+            do ib = 1, nbndsw
+               taua(l,ib) = tauaer(iplon,l,ib)
+               ssaa(l,ib) = ssaaer(iplon,l,ib)
+               asma(l,ib) = asmaer(iplon,l,ib)
+            enddo
+         enddo
+      endif
+
+! Transfer cloud fraction and cloud optical properties to RRTM variables;
+! modify to reverse layer indexing here if necessary.
+
+      if (icld .ge. 1) then 
+         inflag = inflgsw
+         iceflag = iceflgsw
+         liqflag = liqflgsw
+
+! Move incoming GCM cloud arrays to RRTMG cloud arrays.
+! For GCM input, incoming reice is defined based on selected ice parameterization (inflglw)
+
+         do l = 1, nlayers
+            cldfrac(l) = cldfr(iplon,l)
+            ciwp(l) = cicewp(iplon,l)
+            clwp(l) = cliqwp(iplon,l)
+            rei(l) = reice(iplon,l)
+            rel(l) = reliq(iplon,l)
+            do n = 1,nbndsw
+               tauc(n,l) = taucld(n,iplon,l)
+               ssac(n,l) = ssacld(n,iplon,l)
+               asmc(n,l) = asmcld(n,iplon,l)
+               fsfc(n,l) = fsfcld(n,iplon,l)
+            enddo
+         enddo
+
+! If an extra layer is being used in RRTMG, set all cloud properties to zero in the extra layer.
+
+!         cldfrac(nlayers) = 0.0_rb
+!         tauc(:,nlayers) = 0.0_rb
+!         ssac(:,nlayers) = 1.0_rb
+!         asmc(:,nlayers) = 0.0_rb
+!         fsfc(:,nlayers) = 0.0_rb
+!         ciwp(nlayers) = 0.0_rb
+!         clwp(nlayers) = 0.0_rb
+!         rei(nlayers) = 0.0_rb
+!         rel(nlayers) = 0.0_rb
+      
+      endif
+
+      end subroutine inatm_sw
+
+      end module rrtmg_sw_rad
+
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_read_nc.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_read_nc.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_read_nc.f90	(revision 1585)
@@ -0,0 +1,796 @@
+!     path:      $Source$
+!     author:    $Author: mike $
+!     revision:  $Revision: 11660 $
+!     created:   $Date: 2009-05-22 18:20:11 -0400 (Fri, 22 May 2009) $
+
+!=============================================================================== 
+! rrtmg_read_nc.f90
+!
+! Description: This program reads all of the RRTM shortwave data from a NetCDF
+!              file in band by band subroutines, as a replacement for the 
+!              rrtmg_sw_k_g.f90 data statements.
+!
+! Written By: Patrick Hofmann
+! Last Update: 4/3/2009
+!===============================================================================
+
+!*******************************************************************************
+subroutine sw_kgb16
+	use rrsw_kg16, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, no16
+	use rrsw_ncpar
+	use netcdf
+	
+	implicit none
+	save 
+	
+	integer(kind=im), parameter :: bandNumber = 1, numGPoints = no16
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+	 
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+													 
+	status(14) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 16 variables from file" 
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb16
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb17
+        use rrsw_kg17, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, no17
+	use rrsw_ncpar
+	use netcdf
+    
+        implicit none
+        save
+		
+   	integer(kind=im), parameter :: bandNumber = 2
+	integer(kind=im), parameter :: numGPoints = no17
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionUpperAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keyupper,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keyupper,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo(1:3,:), start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+													 
+	status(14) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsUpperAtmos",varID)
+	status(15) = nf90_get_var(ncid, varID, forrefo(4,:), start = (/2,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,numGPoints,1,1/))	
+	
+	status(14) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 17 variables from file"
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb17
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb18
+	use rrsw_kg18, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, no18
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+        integer(kind=im), parameter :: bandNumber = 3
+	integer(kind=im), parameter :: numGPoints = no18
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+	
+	status(14) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 18 variables from file"
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb18
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb19
+        use rrsw_kg19, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, no19
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+		
+        integer(kind=im), parameter :: bandNumber = 4
+	integer(kind=im), parameter :: numGPoints = no19
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+	
+	status(14) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 19 variables from file"
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb19
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb20
+        use rrsw_kg20, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, absch4o, no20
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    
+        integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 5
+	integer(kind=im), parameter :: numGPoints = no20
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo(1:3,:), start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+													 
+	status(14) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsUpperAtmos",varID)
+	status(15) = nf90_get_var(ncid, varID, forrefo(4,:), start = (/2,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,numGPoints,1,1/))												 
+													 
+	!Get absorber index for CH4
+	call getAbsorberIndex('CH4',ab)
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, absch4o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+																				 
+	status(16) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 20 variables from file"																		 
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb20
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb21
+        use rrsw_kg21, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, no21
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+        integer(kind=im), parameter :: bandNumber = 6
+	integer(kind=im), parameter :: numGPoints = no21
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keyupper,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo(1:3,:), start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+													 
+	status(14) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsUpperAtmos",varID)
+	status(15) = nf90_get_var(ncid, varID, forrefo(4,:), start = (/2,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,numGPoints,1,1/))			
+													 
+	status(14) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 21 variables from file"
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb21
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb22	
+        use rrsw_kg22, only: sfluxrefo, kao, kbo, selfrefo, forrefo, rayl, no22
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+   	integer(kind=im), parameter :: bandNumber = 7
+	integer(kind=im), parameter :: numGPoints = no22
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+	
+	status(14) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 22 variables from file"
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb22
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb23		
+        use rrsw_kg23, only: sfluxrefo, kao, selfrefo, forrefo, raylo, no23
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+        integer(kind=im), parameter :: bandNumber = 8
+	integer(kind=im), parameter :: numGPoints = no23
+        integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+        status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, raylo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	 
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(9)  = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(11) = nf90_get_var(ncid, varID, forrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+	
+	status(12) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 23 variables from file"
+	
+end subroutine sw_kgb23
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb24	
+        use rrsw_kg24, only: sfluxrefo, kao, kbo, selfrefo, forrefo, &
+						 raylao, raylbo, abso3ao, abso3bo, no24
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+        integer(kind=im) :: ab
+        integer(kind=im), parameter :: bandNumber = 9
+	integer(kind=im), parameter :: numGPoints = no24
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, raylao, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keylower,1,1/))
+	 
+	status(6)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsUpperAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, raylbo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+		
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(11) = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(13) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(14) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(15) = nf90_get_var(ncid, varID, forrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+	
+	!Get absorber index for O3
+	call getAbsorberIndex('O3',ab)
+	status(16) = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(17) = nf90_get_var(ncid, varID, abso3ao, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,numGPoints,1,1,1/))
+	status(18) = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(19) = nf90_get_var(ncid, varID, abso3bo, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,numGPoints,1,1,1/))
+											
+	status(20) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 24 variables from file"
+	
+end subroutine sw_kgb24
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb25		
+        use rrsw_kg25, only: sfluxrefo, kao, raylo, abso3ao, abso3bo, no25
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    	
+        integer(kind=im) :: ab	
+   	integer(kind=im), parameter :: bandNumber = 10
+	integer(kind=im), parameter :: numGPoints = no25
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, raylo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	 
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	!Get absorber index for O3
+	call getAbsorberIndex('O3',ab)
+	status(8)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, abso3ao, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,numGPoints,1,1,1/))
+	status(10) = nf90_inq_varid(ncid,"AbsorptionCoefficientsUpperAtmos",varID)
+	status(11) = nf90_get_var(ncid, varID, abso3bo, &
+                     start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,numGPoints,1,1,1/))
+											
+	status(12) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 25 variables from file"
+	
+end subroutine sw_kgb25
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb26
+        use rrsw_kg26, only: sfluxrefo, raylo, no26
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+	integer(kind=im), parameter :: bandNumber = 11
+	integer(kind=im), parameter :: numGPoints = no26
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, raylo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	 
+	status(6)  = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 26 variables from file"										
+	
+end subroutine sw_kgb26
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb27
+        use rrsw_kg27, only: sfluxrefo, kao, kbo, raylo, no27
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+		
+	integer(kind=im), parameter :: bandNumber = 12
+	integer(kind=im), parameter :: numGPoints = no27
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, raylo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 27 variables from file"	
+	
+end subroutine sw_kgb27
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb28		
+        use rrsw_kg28, only: sfluxrefo, kao, kbo, rayl, no28
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+    
+	integer(kind=im), parameter :: bandNumber = 13
+	integer(kind=im), parameter :: numGPoints = no28  
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionUpperAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,keyupper,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keylower,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/keyupper,Tdiff,pupper,numGPoints,1,1/))
+				
+	status(10) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 28 variables from file"										
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb28
+!*******************************************************************************
+
+!*******************************************************************************
+subroutine sw_kgb29	
+        use rrsw_kg29, only: sfluxrefo, kao, kbo, selfrefo, forrefo, &
+						 absh2oo, absco2o, rayl, no29
+	use rrsw_ncpar
+	use netcdf
+	
+        implicit none
+        save
+	
+	integer(kind=im) :: ab
+	integer(kind=im), parameter :: bandNumber = 14
+	integer(kind=im), parameter :: numGPoints = no29
+	integer(kind=im), parameter :: gPointSetNumber = 1
+	integer(kind=im) :: ncid, varID
+	
+	real(kind=rb) :: ncrayl(1)
+	
+	status(:)  = nf90_NoErr
+	status(1)  = nf90_open('rrtmg_sw.nc',nf90_nowrite,ncid)
+	
+	status(2)  = nf90_inq_varid(ncid,"SolarSourceFunctionLowerAtmos",varID)
+	status(3)  = nf90_get_var(ncid, varID, sfluxrefo, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/numGPoints,1,1,1/))
+	
+	status(4)  = nf90_inq_varid(ncid,"RayleighExtinctionCoefficientsLowerAtmos",varID)
+	status(5)  = nf90_get_var(ncid, varID, ncrayl, &
+                     start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,1,1,1/))
+		
+	status(6)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsLowerAtmos",varID)
+	status(7)  = nf90_get_var(ncid, varID, kao, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,plower,numGPoints,1,1/))
+	
+	status(8)  = nf90_inq_varid(ncid,"KeySpeciesAbsorptionCoefficientsUpperAtmos",varID)
+	status(9)  = nf90_get_var(ncid, varID, kbo, &
+                     start = (/1,1,1,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,Tdiff,pupper,numGPoints,1,1/))
+	
+	status(10) = nf90_inq_varid(ncid,"H2OSelfAbsorptionCoefficients",varID)
+	status(11) = nf90_get_var(ncid, varID, selfrefo, start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tself,numGPoints,1,1/))
+	
+	status(12) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsLowerAtmos",varID)
+	status(13) = nf90_get_var(ncid, varID, forrefo(1:3,:), start = (/1,1,bandNumber,gPointSetNumber/), &
+                     count = (/Tforeignlower,numGPoints,1,1/))
+													 
+	status(14) = nf90_inq_varid(ncid,"H2OForeignAbsorptionCoefficientsUpperAtmos",varID)
+	status(15) = nf90_get_var(ncid, varID, forrefo(4,:), start = (/2,1,bandNumber,gPointSetNumber/), &
+                     count = (/1,numGPoints,1,1/))	
+	
+	!Get absorber index for H2O
+	call getAbsorberIndex('H2O',ab)
+	status(16)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(17)  = nf90_get_var(ncid, varID, absh2oo, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+							
+	!Get absorber index for CO2
+	call getAbsorberIndex('CO2',ab)
+	status(18)  = nf90_inq_varid(ncid,"AbsorptionCoefficientsLowerAtmos",varID)
+	status(19)  = nf90_get_var(ncid, varID, absco2o, &
+                      start = (/1,1,1,ab,bandNumber,gPointSetNumber/), &
+                      count = (/1,1,numGPoints,1,1,1/))
+	
+	status(18) = nf90_close(ncid)
+	
+	if(any(status(:) /= nf90_NoErr)) stop  "Error reading band 29 variables from file"	
+	
+	rayl = ncrayl(1)
+	
+end subroutine sw_kgb29
+!*******************************************************************************
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_reftra.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_reftra.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_reftra.f90	(revision 1585)
@@ -0,0 +1,308 @@
+!     path:      $Source$
+!     author:    $Author: mike $
+!     revision:  $Revision: 11661 $
+!     created:   $Date: 2009-05-22 18:22:22 -0400 (Fri, 22 May 2009) $
+
+      module rrtmg_sw_reftra
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use rrsw_tbl, only : tblint, bpade, od_lo, exp_tbl
+      use rrsw_vsn, only : hvrrft, hnamrft
+
+      implicit none
+
+      contains
+
+! --------------------------------------------------------------------
+      subroutine reftra_sw(nlayers, lrtchk, pgg, prmuz, ptau, pw, &
+                           pref, prefd, ptra, ptrad)
+! --------------------------------------------------------------------
+  
+! 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)
+!
+!
+! 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(kind=im), intent(in) :: nlayers
+
+      logical, intent(in) :: lrtchk(:)                         ! Logical flag for reflectivity and
+                                                               ! and transmissivity calculation; 
+                                                               !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: pgg(:)                      ! asymmetry parameter
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: ptau(:)                     ! optical depth
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: pw(:)                       ! single scattering albedo 
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: prmuz                       ! cosine of solar zenith angle
+
+! ------- Output -------
+
+      real(kind=rb), intent(inout) :: pref(:)                  ! direct beam reflectivity
+                                                               !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(inout) :: prefd(:)                 ! diffuse beam reflectivity
+                                                               !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(inout) :: ptra(:)                  ! direct beam transmissivity
+                                                               !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(inout) :: ptrad(:)                 ! diffuse beam transmissivity
+                                                               !   Dimensions: (nlayers+1)
+
+! ------- Local -------
+
+      integer(kind=im) :: jk, jl, kmodts
+      integer(kind=im) :: itind
+
+      real(kind=rb) :: tblind
+      real(kind=rb) :: za, za1, za2
+      real(kind=rb) :: zbeta, zdend, zdenr, zdent
+      real(kind=rb) :: ze1, ze2, zem1, zem2, zemm, zep1, zep2
+      real(kind=rb) :: zg, zg3, zgamma1, zgamma2, zgamma3, zgamma4, zgt
+      real(kind=rb) :: zr1, zr2, zr3, zr4, zr5
+      real(kind=rb) :: zrk, zrk2, zrkg, zrm1, zrp, zrp1, zrpp
+      real(kind=rb) :: zsr3, zt1, zt2, zt3, zt4, zt5, zto1
+      real(kind=rb) :: zw, zwcrit, zwo
+
+      real(kind=rb), parameter :: eps = 1.e-08_rb
+
+!     ------------------------------------------------------------------
+
+! Initialize
+
+      hvrrft = '$Revision: 11661 $'
+
+      zsr3=sqrt(3._rb)
+      zwcrit=0.9999995_rb
+      kmodts=2
+
+      do jk=1, nlayers
+         if (.not.lrtchk(jk)) then
+            pref(jk) =0._rb
+            ptra(jk) =1._rb
+            prefd(jk)=0._rb
+            ptrad(jk)=1._rb
+         else
+            zto1=ptau(jk)
+            zw  =pw(jk)
+            zg  =pgg(jk)  
+
+! General two-stream expressions
+
+            zg3= 3._rb * zg
+            if (kmodts == 1) then
+               zgamma1= (7._rb - zw * (4._rb + zg3)) * 0.25_rb
+               zgamma2=-(1._rb - zw * (4._rb - zg3)) * 0.25_rb
+               zgamma3= (2._rb - zg3 * prmuz ) * 0.25_rb
+            else if (kmodts == 2) then  
+               zgamma1= (8._rb - zw * (5._rb + zg3)) * 0.25_rb
+               zgamma2=  3._rb *(zw * (1._rb - zg )) * 0.25_rb
+               zgamma3= (2._rb - zg3 * prmuz ) * 0.25_rb
+            else if (kmodts == 3) then  
+               zgamma1= zsr3 * (2._rb - zw * (1._rb + zg)) * 0.5_rb
+               zgamma2= zsr3 * zw * (1._rb - zg ) * 0.5_rb
+               zgamma3= (1._rb - zsr3 * zg * prmuz ) * 0.5_rb
+            end if
+            zgamma4= 1._rb - zgamma3
+    
+! Recompute original s.s.a. to test for conservative solution
+
+            zwo= zw / (1._rb - (1._rb - zw) * (zg / (1._rb - 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._rb)
+!               ze2 = exp( -ze1 )
+
+! Use exponential lookup table for transmittance, or expansion of 
+! exponential for low tau
+               if (ze1 .le. od_lo) then 
+                  ze2 = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+               else
+                  tblind = ze1 / (bpade + ze1)
+                  itind = tblint * tblind + 0.5_rb
+                  ze2 = exp_tbl(itind)
+               endif
+!
+
+               pref(jk) = (zgt - za1 * (1._rb - ze2)) / (1._rb + zgt)
+               ptra(jk) = 1._rb - pref(jk)
+
+! isotropic incidence
+
+               prefd(jk) = zgt / (1._rb + zgt)
+               ptrad(jk) = 1._rb - prefd(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_rb) then 
+                  pref(jk) = 0.0_rb
+                  ptra(jk) = 1.0_rb
+                  prefd(jk) = 0.0_rb
+                  ptrad(jk) = 1.0_rb
+               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._rb + zrp
+               zrm1 = 1._rb - zrp
+               zrk2 = 2._rb * zrk
+               zrpp = 1._rb - 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, 500._rb)
+               ze2 = min ( zto1 / prmuz , 500._rb)
+!
+! Original
+!              zep1 = exp( ze1 )
+!              zem1 = exp(-ze1 )
+!              zep2 = exp( ze2 )
+!              zem2 = exp(-ze2 )
+!
+! Revised original, to reduce exponentials
+!              zep1 = exp( ze1 )
+!              zem1 = 1._rb / zep1
+!              zep2 = exp( ze2 )
+!              zem2 = 1._rb / zep2
+!
+! Use exponential lookup table for transmittance, or expansion of 
+! exponential for low tau
+               if (ze1 .le. od_lo) then 
+                  zem1 = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+                  zep1 = 1._rb / zem1
+               else
+                  tblind = ze1 / (bpade + ze1)
+                  itind = tblint * tblind + 0.5_rb
+                  zem1 = exp_tbl(itind)
+                  zep1 = 1._rb / zem1
+               endif
+
+               if (ze2 .le. od_lo) then 
+                  zem2 = 1._rb - ze2 + 0.5_rb * ze2 * ze2
+                  zep2 = 1._rb / zem2
+               else
+                  tblind = ze2 / (bpade + ze2)
+                  itind = tblint * tblind + 0.5_rb
+                  zem2 = exp_tbl(itind)
+                  zep2 = 1._rb / zem2
+               endif
+
+! collimated beam
+
+! mji - reformulated code to avoid potential floating point exceptions
+!               zdenr = zr4*zep1 + zr5*zem1
+!               pref(jk) = zw * (zr1*zep1 - zr2*zem1 - zr3*zem2) / zdenr
+!               zdent = zt4*zep1 + zt5*zem1
+!               ptra(jk) = zem2 - zem2 * zw * (zt1*zep1 - zt2*zem1 - zt3*zep2) / zdent
+
+               zdenr = zr4*zep1 + zr5*zem1
+               zdent = zt4*zep1 + zt5*zem1
+               if (zdenr .ge. -eps .and. zdenr .le. eps) then
+                  pref(jk) = eps
+                  ptra(jk) = zem2
+               else 
+                  pref(jk) = zw * (zr1*zep1 - zr2*zem1 - zr3*zem2) / zdenr
+                  ptra(jk) = zem2 - zem2 * zw * (zt1*zep1 - zt2*zem1 - zt3*zep2) / zdent
+               endif
+!!
+
+! diffuse beam
+
+               zemm = zem1*zem1
+               zdend = 1._rb / ( (1._rb - zbeta*zemm ) * zrkg)
+               prefd(jk) =  zgamma2 * (1._rb - zemm) * zdend
+               ptrad(jk) =  zrk2*zem1*zdend
+
+            endif
+
+         endif         
+
+      enddo    
+
+      end subroutine reftra_sw
+
+      end module rrtmg_sw_reftra
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_setcoef.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_setcoef.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_setcoef.f90	(revision 1585)
@@ -0,0 +1,347 @@
+!     path:      $Source$
+!     author:    $Author: miacono $
+!     revision:  $Revision: 23308 $
+!     created:   $Date: 2013-12-27 17:23:51 -0500 (Fri, 27 Dec 2013) $
+
+      module rrtmg_sw_setcoef
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, only : mxmol
+      use rrsw_ref, only : pref, preflog, tref
+      use rrsw_vsn, only : hvrset, hnamset
+
+      implicit none
+
+      contains
+
+!----------------------------------------------------------------------------
+      subroutine setcoef_sw(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(kind=im), intent(in) :: nlayers         ! total number of layers
+
+      real(kind=rb), intent(in) :: pavel(:)           ! layer pressures (mb) 
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tavel(:)           ! layer temperatures (K)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: pz(0:)             ! level (interface) pressures (hPa, mb)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tz(0:)             ! level (interface) temperatures (K)
+                                                      !    Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tbound             ! surface temperature (K)
+      real(kind=rb), intent(in) :: coldry(:)          ! dry air column density (mol/cm2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: wkl(:,:)           ! molecular amounts (mol/cm-2)
+                                                      !    Dimensions: (mxmol,nlayers)
+
+! ----- Output -----
+      integer(kind=im), intent(out) :: laytrop        ! tropopause layer index
+      integer(kind=im), intent(out) :: layswtch       ! 
+      integer(kind=im), intent(out) :: laylow         ! 
+
+      integer(kind=im), intent(out) :: jp(:)          ! 
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(out) :: jt(:)          !
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(out) :: jt1(:)         !
+                                                      !    Dimensions: (nlayers)
+
+      real(kind=rb), intent(out) :: colh2o(:)         ! column amount (h2o)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colco2(:)         ! column amount (co2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colo3(:)          ! column amount (o3)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: coln2o(:)         ! column amount (n2o)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colch4(:)         ! column amount (ch4)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colo2(:)          ! column amount (o2)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: colmol(:)         ! 
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: co2mult(:)        !
+                                                      !    Dimensions: (nlayers)
+
+      integer(kind=im), intent(out) :: indself(:)
+                                                      !    Dimensions: (nlayers)
+      integer(kind=im), intent(out) :: indfor(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: selffac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: selffrac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: forfac(:)
+                                                      !    Dimensions: (nlayers)
+      real(kind=rb), intent(out) :: forfrac(:)
+                                                      !    Dimensions: (nlayers)
+
+      real(kind=rb), intent(out) :: &                 !
+                         fac00(:), fac01(:), &        !    Dimensions: (nlayers)
+                         fac10(:), fac11(:) 
+
+! ----- Local -----
+
+      integer(kind=im) :: indbound
+      integer(kind=im) :: indlev0
+      integer(kind=im) :: lay
+      integer(kind=im) :: jp1
+
+      real(kind=rb) :: stpfac
+      real(kind=rb) :: tbndfrac
+      real(kind=rb) :: t0frac
+      real(kind=rb) :: plog
+      real(kind=rb) :: fp
+      real(kind=rb) :: ft
+      real(kind=rb) :: ft1
+      real(kind=rb) :: water
+      real(kind=rb) :: scalefac
+      real(kind=rb) :: factor
+      real(kind=rb) :: co2reg
+      real(kind=rb) :: compfp
+
+
+! Initializations
+      stpfac = 296._rb/1013._rb
+
+      indbound = tbound - 159._rb
+      tbndfrac = tbound - int(tbound)
+      indlev0  = tz(0) - 159._rb
+      t0frac   = tz(0) - int(tz(0))
+
+      laytrop  = 0
+      layswtch = 0
+      laylow   = 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(lay))
+         jp(lay) = int(36._rb - 5*(plog+0.04_rb))
+         if (jp(lay) .lt. 1) then
+            jp(lay) = 1
+         elseif (jp(lay) .gt. 58) then
+            jp(lay) = 58
+         endif
+         jp1 = jp(lay) + 1
+         fp = 5._rb * (preflog(jp(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(lay) = int(3._rb + (tavel(lay)-tref(jp(lay)))/15._rb)
+         if (jt(lay) .lt. 1) then
+            jt(lay) = 1
+         elseif (jt(lay) .gt. 4) then
+            jt(lay) = 4
+         endif
+         ft = ((tavel(lay)-tref(jp(lay)))/15._rb) - real((jt(lay)-3),kind=rb)
+         jt1(lay) = int(3._rb + (tavel(lay)-tref(jp1))/15._rb)
+         if (jt1(lay) .lt. 1) then
+            jt1(lay) = 1
+         elseif (jt1(lay) .gt. 4) then
+            jt1(lay) = 4
+         endif
+         ft1 = ((tavel(lay)-tref(jp1))/15._rb) - real((jt1(lay)-3),kind=rb)
+
+         water = wkl(1,lay)/coldry(lay)
+         scalefac = pavel(lay) * stpfac / tavel(lay)
+
+! If the pressure is less than ~100mb, perform a different
+! set of species interpolations.
+
+         if (plog .le. 4.56_rb) go to 5300
+         laytrop =  laytrop + 1
+         if (plog .ge. 6.62_rb) laylow = laylow + 1
+
+! Set up factors needed to separately include the water vapor
+! foreign-continuum in the calculation of absorption coefficient.
+
+         forfac(lay) = scalefac / (1.+water)
+         factor = (332.0_rb-tavel(lay))/36.0_rb
+         indfor(lay) = min(2, max(1, int(factor)))
+         forfrac(lay) = factor - real(indfor(lay),kind=rb)
+
+! Set up factors needed to separately include the water vapor
+! self-continuum in the calculation of absorption coefficient.
+
+         selffac(lay) = water * forfac(lay)
+         factor = (tavel(lay)-188.0_rb)/7.2_rb
+         indself(lay) = min(9, max(1, int(factor)-7))
+         selffrac(lay) = factor - real((indself(lay) + 7),kind=rb)
+
+! Calculate needed column amounts.
+
+         colh2o(lay) = 1.e-20_rb * wkl(1,lay)
+         colco2(lay) = 1.e-20_rb * wkl(2,lay)
+         colo3(lay) = 1.e-20_rb * wkl(3,lay)
+!           colo3(lay) = 0._rb
+!           colo3(lay) = colo3(lay)/1.16_rb
+         coln2o(lay) = 1.e-20_rb * wkl(4,lay)
+         colch4(lay) = 1.e-20_rb * wkl(6,lay)
+         colo2(lay) = 1.e-20_rb * wkl(7,lay)
+         colmol(lay) = 1.e-20_rb * coldry(lay) + colh2o(lay)
+!           colco2(lay) = 0._rb
+!           colo3(lay) = 0._rb
+!           coln2o(lay) = 0._rb
+!           colch4(lay) = 0._rb
+!           colo2(lay) = 0._rb
+!           colmol(lay) = 0._rb
+         if (colco2(lay) .eq. 0._rb) colco2(lay) = 1.e-32_rb * coldry(lay)
+         if (coln2o(lay) .eq. 0._rb) coln2o(lay) = 1.e-32_rb * coldry(lay)
+         if (colch4(lay) .eq. 0._rb) colch4(lay) = 1.e-32_rb * coldry(lay)
+         if (colo2(lay) .eq. 0._rb) colo2(lay) = 1.e-32_rb * coldry(lay)
+! Using E = 1334.2 cm-1.
+         co2reg = 3.55e-24_rb * coldry(lay)
+         co2mult(lay)= (colco2(lay) - co2reg) * &
+               272.63_rb*exp(-1919.4_rb/tavel(lay))/(8.7604e-4_rb*tavel(lay))
+         goto 5400
+
+! Above laytrop.
+ 5300    continue
+
+! Set up factors needed to separately include the water vapor
+! foreign-continuum in the calculation of absorption coefficient.
+
+         forfac(lay) = scalefac / (1.+water)
+         factor = (tavel(lay)-188.0_rb)/36.0_rb
+         indfor(lay) = 3
+         forfrac(lay) = factor - 1.0_rb
+
+! Calculate needed column amounts.
+
+         colh2o(lay) = 1.e-20_rb * wkl(1,lay)
+         colco2(lay) = 1.e-20_rb * wkl(2,lay)
+         colo3(lay)  = 1.e-20_rb * wkl(3,lay)
+         coln2o(lay) = 1.e-20_rb * wkl(4,lay)
+         colch4(lay) = 1.e-20_rb * wkl(6,lay)
+         colo2(lay)  = 1.e-20_rb * wkl(7,lay)
+         colmol(lay) = 1.e-20_rb * coldry(lay) + colh2o(lay)
+         if (colco2(lay) .eq. 0._rb) colco2(lay) = 1.e-32_rb * coldry(lay)
+         if (coln2o(lay) .eq. 0._rb) coln2o(lay) = 1.e-32_rb * coldry(lay)
+         if (colch4(lay) .eq. 0._rb) colch4(lay) = 1.e-32_rb * coldry(lay)
+         if (colo2(lay)  .eq. 0._rb) colo2(lay)  = 1.e-32_rb * coldry(lay)
+         co2reg = 3.55e-24_rb * coldry(lay)
+         co2mult(lay)= (colco2(lay) - co2reg) * &
+               272.63_rb*exp(-1919.4_rb/tavel(lay))/(8.7604e-4_rb*tavel(lay))
+
+         selffac(lay) = 0._rb
+         selffrac(lay)= 0._rb
+         indself(lay) = 0
+
+ 5400    continue
+
+! We have now isolated the layer ln pressure and temperature,
+! between two reference pressures and two reference temperatures 
+! (for each reference pressure).  We multiply the pressure 
+! fraction FP with the appropriate temperature fractions to get 
+! the factors that will be needed for the interpolation that yields
+! the optical depths (performed in routines TAUGBn for band n).
+
+         compfp = 1._rb - fp
+         fac10(lay) = compfp * ft
+         fac00(lay) = compfp * (1._rb - ft)
+         fac11(lay) = fp * ft1
+         fac01(lay) = fp * (1._rb - ft1)
+
+! End layer loop
+      enddo
+
+      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_rb,8.62642e+02_rb,7.06272e+02_rb,5.78246e+02_rb,4.73428e+02_rb, &
+          3.87610e+02_rb,3.17348e+02_rb,2.59823e+02_rb,2.12725e+02_rb,1.74164e+02_rb, &
+          1.42594e+02_rb,1.16746e+02_rb,9.55835e+01_rb,7.82571e+01_rb,6.40715e+01_rb, &
+          5.24573e+01_rb,4.29484e+01_rb,3.51632e+01_rb,2.87892e+01_rb,2.35706e+01_rb, &
+          1.92980e+01_rb,1.57998e+01_rb,1.29358e+01_rb,1.05910e+01_rb,8.67114e+00_rb, &
+          7.09933e+00_rb,5.81244e+00_rb,4.75882e+00_rb,3.89619e+00_rb,3.18993e+00_rb, &
+          2.61170e+00_rb,2.13828e+00_rb,1.75067e+00_rb,1.43333e+00_rb,1.17351e+00_rb, &
+          9.60789e-01_rb,7.86628e-01_rb,6.44036e-01_rb,5.27292e-01_rb,4.31710e-01_rb, &
+          3.53455e-01_rb,2.89384e-01_rb,2.36928e-01_rb,1.93980e-01_rb,1.58817e-01_rb, &
+          1.30029e-01_rb,1.06458e-01_rb,8.71608e-02_rb,7.13612e-02_rb,5.84256e-02_rb, &
+          4.78349e-02_rb,3.91639e-02_rb,3.20647e-02_rb,2.62523e-02_rb,2.14936e-02_rb, &
+          1.75975e-02_rb,1.44076e-02_rb,1.17959e-02_rb,9.65769e-03_rb /)
+
+      preflog(:) = (/ &
+           6.9600e+00_rb, 6.7600e+00_rb, 6.5600e+00_rb, 6.3600e+00_rb, 6.1600e+00_rb, &
+           5.9600e+00_rb, 5.7600e+00_rb, 5.5600e+00_rb, 5.3600e+00_rb, 5.1600e+00_rb, &
+           4.9600e+00_rb, 4.7600e+00_rb, 4.5600e+00_rb, 4.3600e+00_rb, 4.1600e+00_rb, &
+           3.9600e+00_rb, 3.7600e+00_rb, 3.5600e+00_rb, 3.3600e+00_rb, 3.1600e+00_rb, &
+           2.9600e+00_rb, 2.7600e+00_rb, 2.5600e+00_rb, 2.3600e+00_rb, 2.1600e+00_rb, &
+           1.9600e+00_rb, 1.7600e+00_rb, 1.5600e+00_rb, 1.3600e+00_rb, 1.1600e+00_rb, &
+           9.6000e-01_rb, 7.6000e-01_rb, 5.6000e-01_rb, 3.6000e-01_rb, 1.6000e-01_rb, &
+          -4.0000e-02_rb,-2.4000e-01_rb,-4.4000e-01_rb,-6.4000e-01_rb,-8.4000e-01_rb, &
+          -1.0400e+00_rb,-1.2400e+00_rb,-1.4400e+00_rb,-1.6400e+00_rb,-1.8400e+00_rb, &
+          -2.0400e+00_rb,-2.2400e+00_rb,-2.4400e+00_rb,-2.6400e+00_rb,-2.8400e+00_rb, &
+          -3.0400e+00_rb,-3.2400e+00_rb,-3.4400e+00_rb,-3.6400e+00_rb,-3.8400e+00_rb, &
+          -4.0400e+00_rb,-4.2400e+00_rb,-4.4400e+00_rb,-4.6400e+00_rb /)
+
+! These are the temperatures associated with the respective 
+! pressures for the MLS standard atmosphere. 
+
+      tref(:) = (/ &
+           2.9420e+02_rb, 2.8799e+02_rb, 2.7894e+02_rb, 2.6925e+02_rb, 2.5983e+02_rb, &
+           2.5017e+02_rb, 2.4077e+02_rb, 2.3179e+02_rb, 2.2306e+02_rb, 2.1578e+02_rb, &
+           2.1570e+02_rb, 2.1570e+02_rb, 2.1570e+02_rb, 2.1706e+02_rb, 2.1858e+02_rb, &
+           2.2018e+02_rb, 2.2174e+02_rb, 2.2328e+02_rb, 2.2479e+02_rb, 2.2655e+02_rb, &
+           2.2834e+02_rb, 2.3113e+02_rb, 2.3401e+02_rb, 2.3703e+02_rb, 2.4022e+02_rb, &
+           2.4371e+02_rb, 2.4726e+02_rb, 2.5085e+02_rb, 2.5457e+02_rb, 2.5832e+02_rb, &
+           2.6216e+02_rb, 2.6606e+02_rb, 2.6999e+02_rb, 2.7340e+02_rb, 2.7536e+02_rb, &
+           2.7568e+02_rb, 2.7372e+02_rb, 2.7163e+02_rb, 2.6955e+02_rb, 2.6593e+02_rb, &
+           2.6211e+02_rb, 2.5828e+02_rb, 2.5360e+02_rb, 2.4854e+02_rb, 2.4348e+02_rb, & 
+           2.3809e+02_rb, 2.3206e+02_rb, 2.2603e+02_rb, 2.2000e+02_rb, 2.1435e+02_rb, &
+           2.0887e+02_rb, 2.0340e+02_rb, 1.9792e+02_rb, 1.9290e+02_rb, 1.8809e+02_rb, &
+           1.8329e+02_rb, 1.7849e+02_rb, 1.7394e+02_rb, 1.7212e+02_rb /)
+
+      end subroutine swatmref
+
+      end module rrtmg_sw_setcoef
+
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_spcvmc.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_spcvmc.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_spcvmc.f90	(revision 1585)
@@ -0,0 +1,628 @@
+!     path:      $Source$
+!     author:    $Author: mike $
+!     revision:  $Revision: 11661 $
+!     created:   $Date: 2009-05-22 18:22:22 -0400 (Fri, 22 May 2009) $
+
+      module rrtmg_sw_spcvmc
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, only : nbndsw, ngptsw, mxmol, jpband
+      use rrsw_tbl, only : tblint, bpade, od_lo, exp_tbl
+      use rrsw_vsn, only : hvrspc, hnamspc
+      use rrsw_wvn, only : ngc, ngs
+      use rrtmg_sw_reftra, only: reftra_sw
+      use rrtmg_sw_taumol, only: taumol_sw
+      use rrtmg_sw_vrtqdr, only: vrtqdr_sw
+
+      implicit none
+
+      contains
+
+! ---------------------------------------------------------------------------
+      subroutine spcvmc_sw &
+            (nlayers, istart, iend, icpr, idelm, iout, &
+             pavel, tavel, pz, tz, tbound, palbd, palbp, &
+             pcldfmc, ptaucmc, pasycmc, pomgcmc, ptaormc, &
+             ptaua, pasya, pomga, prmu0, coldry, wkl, 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)
+! ---------------------------------------------------------------------------
+!
+! 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(kind=im), intent(in) :: nlayers
+      integer(kind=im), intent(in) :: istart
+      integer(kind=im), intent(in) :: iend
+      integer(kind=im), intent(in) :: icpr
+      integer(kind=im), intent(in) :: idelm   ! delta-m scaling flag
+                                              ! [0 = direct and diffuse fluxes are unscaled]
+                                              ! [1 = direct and diffuse fluxes are scaled]
+      integer(kind=im), intent(in) :: iout
+      integer(kind=im), intent(in) :: laytrop
+      integer(kind=im), intent(in) :: layswtch
+      integer(kind=im), intent(in) :: laylow
+
+      integer(kind=im), intent(in) :: indfor(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: indself(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jp(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt1(:)
+                                                               !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: pavel(:)                    ! layer pressure (hPa, mb) 
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tavel(:)                    ! layer temperature (K)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: pz(0:)                      ! level (interface) pressure (hPa, mb)
+                                                               !   Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tz(0:)                      ! level temperatures (hPa, mb)
+                                                               !   Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tbound                      ! surface temperature (K)
+      real(kind=rb), intent(in) :: wkl(:,:)                    ! molecular amounts (mol/cm2) 
+                                                               !   Dimensions: (mxmol,nlayers)
+      real(kind=rb), intent(in) :: coldry(:)                   ! dry air column density (mol/cm2)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colmol(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: adjflux(:)                  ! Earth/Sun distance adjustment
+                                                               !   Dimensions: (jpband)
+
+      real(kind=rb), intent(in) :: palbd(:)                    ! surface albedo (diffuse)
+                                                               !   Dimensions: (nbndsw)
+      real(kind=rb), intent(in) :: palbp(:)                    ! surface albedo (direct)
+                                                               !   Dimensions: (nbndsw)
+      real(kind=rb), intent(in) :: prmu0                       ! cosine of solar zenith angle
+      real(kind=rb), intent(in) :: pcldfmc(:,:)                ! cloud fraction [mcica]
+                                                               !   Dimensions: (nlayers,ngptsw)
+      real(kind=rb), intent(in) :: ptaucmc(:,:)                ! cloud optical depth [mcica]
+                                                               !   Dimensions: (nlayers,ngptsw)
+      real(kind=rb), intent(in) :: pasycmc(:,:)                ! cloud asymmetry parameter [mcica]
+                                                               !   Dimensions: (nlayers,ngptsw)
+      real(kind=rb), intent(in) :: pomgcmc(:,:)                ! cloud single scattering albedo [mcica]
+                                                               !   Dimensions: (nlayers,ngptsw)
+      real(kind=rb), intent(in) :: ptaormc(:,:)                ! cloud optical depth, non-delta scaled [mcica]
+                                                               !   Dimensions: (nlayers,ngptsw)
+      real(kind=rb), intent(in) :: ptaua(:,:)                  ! aerosol optical depth
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: pasya(:,:)                  ! aerosol asymmetry parameter
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: pomga(:,:)                  ! aerosol single scattering albedo
+                                                               !   Dimensions: (nlayers,nbndsw)
+
+      real(kind=rb), intent(in) :: colh2o(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colco2(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colch4(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: co2mult(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo3(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo2(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: coln2o(:)
+                                                               !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: forfac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: forfrac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffrac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac00(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac01(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac10(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac11(:)
+                                                               !   Dimensions: (nlayers)
+
+! ------- Output -------
+                                                               !   All Dimensions: (nlayers+1)
+      real(kind=rb), intent(out) :: pbbcd(:)
+      real(kind=rb), intent(out) :: pbbcu(:)
+      real(kind=rb), intent(out) :: pbbfd(:)
+      real(kind=rb), intent(out) :: pbbfu(:)
+      real(kind=rb), intent(out) :: pbbfddir(:)
+      real(kind=rb), intent(out) :: pbbcddir(:)
+
+      real(kind=rb), intent(out) :: puvcd(:)
+      real(kind=rb), intent(out) :: puvfd(:)
+      real(kind=rb), intent(out) :: puvcddir(:)
+      real(kind=rb), intent(out) :: puvfddir(:)
+
+      real(kind=rb), intent(out) :: pnicd(:)
+      real(kind=rb), intent(out) :: pnifd(:)
+      real(kind=rb), intent(out) :: pnicddir(:)
+      real(kind=rb), intent(out) :: pnifddir(:)
+
+! Output - inactive                                            !   All Dimensions: (nlayers+1)
+!      real(kind=rb), intent(out) :: puvcu(:)
+!      real(kind=rb), intent(out) :: puvfu(:)
+!      real(kind=rb), intent(out) :: pnicu(:)
+!      real(kind=rb), intent(out) :: pnifu(:)
+!      real(kind=rb), intent(out) :: pvscd(:)
+!      real(kind=rb), intent(out) :: pvscu(:)
+!      real(kind=rb), intent(out) :: pvsfd(:)
+!      real(kind=rb), intent(out) :: pvsfu(:)
+
+! ------- Local -------
+
+      logical :: lrtchkclr(nlayers),lrtchkcld(nlayers)
+
+      integer(kind=im)  :: klev
+      integer(kind=im) :: ib1, ib2, ibm, igt, ikl, ikp, ikx
+      integer(kind=im) :: iw, jb, jg, jl, jk
+!      integer(kind=im), parameter :: nuv = ?? 
+!      integer(kind=im), parameter :: nvs = ?? 
+      integer(kind=im) :: itind
+
+      real(kind=rb) :: tblind, ze1
+      real(kind=rb) :: zclear, zcloud
+      real(kind=rb) :: zdbt(nlayers+1), zdbt_nodel(nlayers+1)
+      real(kind=rb) :: zgc(nlayers), zgcc(nlayers), zgco(nlayers)
+      real(kind=rb) :: zomc(nlayers), zomcc(nlayers), zomco(nlayers)
+      real(kind=rb) :: zrdnd(nlayers+1), zrdndc(nlayers+1)
+      real(kind=rb) :: zref(nlayers+1), zrefc(nlayers+1), zrefo(nlayers+1)
+      real(kind=rb) :: zrefd(nlayers+1), zrefdc(nlayers+1), zrefdo(nlayers+1)
+      real(kind=rb) :: zrup(nlayers+1), zrupd(nlayers+1)
+      real(kind=rb) :: zrupc(nlayers+1), zrupdc(nlayers+1)
+      real(kind=rb) :: zs1(nlayers+1)
+      real(kind=rb) :: ztauc(nlayers), ztauo(nlayers)
+      real(kind=rb) :: ztdn(nlayers+1), ztdnd(nlayers+1), ztdbt(nlayers+1)
+      real(kind=rb) :: ztoc(nlayers), ztor(nlayers)
+      real(kind=rb) :: ztra(nlayers+1), ztrac(nlayers+1), ztrao(nlayers+1)
+      real(kind=rb) :: ztrad(nlayers+1), ztradc(nlayers+1), ztrado(nlayers+1)
+      real(kind=rb) :: zdbtc(nlayers+1), ztdbtc(nlayers+1)
+      real(kind=rb) :: zincflx(ngptsw), zdbtc_nodel(nlayers+1) 
+      real(kind=rb) :: ztdbt_nodel(nlayers+1), ztdbtc_nodel(nlayers+1)
+
+      real(kind=rb) :: zdbtmc, zdbtmo, zf, zgw, zreflect
+      real(kind=rb) :: zwf, tauorig, repclc
+!     real(kind=rb) :: zincflux                                   ! inactive
+
+! Arrays from rrtmg_sw_taumoln routines
+
+!      real(kind=rb) :: ztaug(nlayers,16), ztaur(nlayers,16)
+!      real(kind=rb) :: zsflxzen(16)
+      real(kind=rb) :: ztaug(nlayers,ngptsw), ztaur(nlayers,ngptsw)
+      real(kind=rb) :: zsflxzen(ngptsw)
+
+! Arrays from rrtmg_sw_vrtqdr routine
+
+      real(kind=rb) :: zcd(nlayers+1,ngptsw), zcu(nlayers+1,ngptsw)
+      real(kind=rb) :: zfd(nlayers+1,ngptsw), zfu(nlayers+1,ngptsw)
+
+! Inactive arrays
+!     real(kind=rb) :: zbbcd(nlayers+1), zbbcu(nlayers+1)
+!     real(kind=rb) :: zbbfd(nlayers+1), zbbfu(nlayers+1)
+!     real(kind=rb) :: zbbfddir(nlayers+1), zbbcddir(nlayers+1)
+
+! ------------------------------------------------------------------
+
+! Initializations
+
+      ib1 = istart
+      ib2 = iend
+      klev = nlayers
+      iw = 0
+      repclc = 1.e-12_rb
+!      zincflux = 0.0_rb
+
+      do jk=1,klev+1
+         pbbcd(jk)=0._rb
+         pbbcu(jk)=0._rb
+         pbbfd(jk)=0._rb
+         pbbfu(jk)=0._rb
+         pbbcddir(jk)=0._rb
+         pbbfddir(jk)=0._rb
+         puvcd(jk)=0._rb
+         puvfd(jk)=0._rb
+         puvcddir(jk)=0._rb
+         puvfddir(jk)=0._rb
+         pnicd(jk)=0._rb
+         pnifd(jk)=0._rb
+         pnicddir(jk)=0._rb
+         pnifddir(jk)=0._rb
+      enddo
+
+
+! Calculate the optical depths for gaseous absorption and Rayleigh scattering
+
+      call taumol_sw(klev, &
+                     colh2o, colco2, colch4, colo2, colo3, colmol, &
+                     laytrop, jp, jt, jt1, &
+                     fac00, fac01, fac10, fac11, &
+                     selffac, selffrac, indself, forfac, forfrac, indfor, &
+                     zsflxzen, ztaug, ztaur)
+
+! Top of shortwave spectral band loop, jb = 16 -> 29; ibm = 1 -> 14
+
+      do jb = ib1, ib2
+         ibm = jb-15
+         igt = ngc(ibm)
+
+! Reinitialize g-point counter for each band if output for each band is requested.
+         if (iout.gt.0.and.ibm.ge.2) iw = ngs(ibm-1)
+
+!        do jk=1,klev+1
+!           zbbcd(jk)=0.0_rb
+!           zbbcu(jk)=0.0_rb
+!           zbbfd(jk)=0.0_rb
+!           zbbfu(jk)=0.0_rb
+!        enddo
+
+! Top of g-point interval loop within each band (iw is cumulative counter) 
+         do jg = 1,igt
+            iw = iw+1
+
+! Apply adjustment for correct Earth/Sun distance and zenith angle to incoming solar flux
+            zincflx(iw) = adjflux(jb) * zsflxzen(iw) * prmu0
+!             zincflux = zincflux + adjflux(jb) * zsflxzen(iw) * prmu0           ! inactive
+
+! Compute layer reflectances and transmittances for direct and diffuse sources, 
+! first clear then cloudy
+
+! zrefc(jk)  direct albedo for clear
+! zrefo(jk)  direct albedo for cloud
+! zrefdc(jk) diffuse albedo for clear
+! zrefdo(jk) diffuse albedo for cloud
+! ztrac(jk)  direct transmittance for clear
+! ztrao(jk)  direct transmittance for cloudy
+! ztradc(jk) diffuse transmittance for clear
+! ztrado(jk) diffuse transmittance for cloudy
+!  
+! zref(jk)   direct reflectance
+! zrefd(jk)  diffuse reflectance
+! ztra(jk)   direct transmittance
+! ztrad(jk)  diffuse transmittance
+!
+! zdbtc(jk)  clear direct beam transmittance
+! zdbto(jk)  cloudy direct beam transmittance
+! zdbt(jk)   layer mean direct beam transmittance
+! ztdbt(jk)  total direct beam transmittance at levels
+
+! Clear-sky    
+!   TOA direct beam    
+            ztdbtc(1)=1.0_rb
+            ztdbtc_nodel(1)=1.0_rb
+!   Surface values
+            zdbtc(klev+1) =0.0_rb
+            ztrac(klev+1) =0.0_rb
+            ztradc(klev+1)=0.0_rb
+            zrefc(klev+1) =palbp(ibm)
+            zrefdc(klev+1)=palbd(ibm)
+            zrupc(klev+1) =palbp(ibm)
+            zrupdc(klev+1)=palbd(ibm)
+           
+! Cloudy-sky    
+!   Surface values
+            ztrao(klev+1) =0.0_rb
+            ztrado(klev+1)=0.0_rb
+            zrefo(klev+1) =palbp(ibm)
+            zrefdo(klev+1)=palbd(ibm)
+           
+! Total sky    
+!   TOA direct beam    
+            ztdbt(1)=1.0_rb
+            ztdbt_nodel(1)=1.0_rb
+!   Surface values
+            zdbt(klev+1) =0.0_rb
+            ztra(klev+1) =0.0_rb
+            ztrad(klev+1)=0.0_rb
+            zref(klev+1) =palbp(ibm)
+            zrefd(klev+1)=palbd(ibm)
+            zrup(klev+1) =palbp(ibm)
+            zrupd(klev+1)=palbd(ibm)
+    
+! Top of layer loop
+            do jk=1,klev
+
+! Note: two-stream calculations proceed from top to bottom; 
+!   RRTMG_SW quantities are given bottom to top and are reversed here
+
+               ikl=klev+1-jk
+
+! Set logical flag to do REFTRA calculation
+!   Do REFTRA for all clear layers
+               lrtchkclr(jk)=.true.
+
+!   Do REFTRA only for cloudy layers in profile, since already done for clear layers
+               lrtchkcld(jk)=.false.
+               lrtchkcld(jk)=(pcldfmc(ikl,iw) > repclc)
+
+! Clear-sky optical parameters - this section inactive     
+!   Original
+!               ztauc(jk) = ztaur(ikl,iw) + ztaug(ikl,iw)
+!               zomcc(jk) = ztaur(ikl,iw) / ztauc(jk)
+!               zgcc(jk) = 0.0001_rb
+!   Total sky optical parameters        
+!               ztauo(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaucmc(ikl,iw)
+!               zomco(jk) = ptaucmc(ikl,iw) * pomgcmc(ikl,iw) + ztaur(ikl,iw)
+!               zgco (jk) = (ptaucmc(ikl,iw) * pomgcmc(ikl,iw) * pasycmc(ikl,iw) + &
+!                           ztaur(ikl,iw) * 0.0001_rb) / zomco(jk)
+!               zomco(jk) = zomco(jk) / ztauo(jk)
+
+! Clear-sky optical parameters including aerosols
+               ztauc(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaua(ikl,ibm)
+               zomcc(jk) = ztaur(ikl,iw) * 1.0_rb + ptaua(ikl,ibm) * pomga(ikl,ibm)
+               zgcc(jk) = pasya(ikl,ibm) * pomga(ikl,ibm) * ptaua(ikl,ibm) / zomcc(jk)
+               zomcc(jk) = zomcc(jk) / ztauc(jk)
+
+! Pre-delta-scaling clear and cloudy direct beam transmittance (must use 'orig', unscaled cloud OD)       
+!   \/\/\/ This block of code is only needed for unscaled direct beam calculation
+               if (idelm .eq. 0) then
+!     
+                  zclear = 1.0_rb - pcldfmc(ikl,iw)
+                  zcloud = pcldfmc(ikl,iw)
+
+! Clear
+!                   zdbtmc = exp(-ztauc(jk) / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of exponential for low tau
+                  ze1 = ztauc(jk) / prmu0
+                  if (ze1 .le. od_lo) then
+                     zdbtmc = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+                  else 
+                     tblind = ze1 / (bpade + ze1)
+                     itind = tblint * tblind + 0.5_rb
+                     zdbtmc = exp_tbl(itind)
+                  endif
+
+                  zdbtc_nodel(jk) = zdbtmc
+                  ztdbtc_nodel(jk+1) = zdbtc_nodel(jk) * ztdbtc_nodel(jk)
+
+! Clear + Cloud
+                  tauorig = ztauc(jk) + ptaormc(ikl,iw)
+!                   zdbtmo = exp(-tauorig / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of exponential for low tau
+                  ze1 = tauorig / prmu0
+                  if (ze1 .le. od_lo) then
+                     zdbtmo = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+                  else
+                     tblind = ze1 / (bpade + ze1)
+                     itind = tblint * tblind + 0.5_rb
+                     zdbtmo = exp_tbl(itind)
+                  endif
+
+                  zdbt_nodel(jk) = zclear*zdbtmc + zcloud*zdbtmo
+                  ztdbt_nodel(jk+1) = zdbt_nodel(jk) * ztdbt_nodel(jk)
+
+               endif
+!   /\/\/\ Above code only needed for unscaled direct beam calculation
+
+
+! Delta scaling - clear   
+               zf = zgcc(jk) * zgcc(jk)
+               zwf = zomcc(jk) * zf
+               ztauc(jk) = (1.0_rb - zwf) * ztauc(jk)
+               zomcc(jk) = (zomcc(jk) - zwf) / (1.0_rb - zwf)
+               zgcc (jk) = (zgcc(jk) - zf) / (1.0_rb - zf)
+
+! Total sky optical parameters (cloud properties already delta-scaled)
+!   Use this code if cloud properties are derived in rrtmg_sw_cldprop       
+               if (icpr .ge. 1) then
+                  ztauo(jk) = ztauc(jk) + ptaucmc(ikl,iw)
+                  zomco(jk) = ztauc(jk) * zomcc(jk) + ptaucmc(ikl,iw) * pomgcmc(ikl,iw) 
+                  zgco (jk) = (ptaucmc(ikl,iw) * pomgcmc(ikl,iw) * pasycmc(ikl,iw) + &
+                              ztauc(jk) * zomcc(jk) * zgcc(jk)) / zomco(jk)
+                  zomco(jk) = zomco(jk) / ztauo(jk)
+
+! Total sky optical parameters (if cloud properties not delta scaled)
+!   Use this code if cloud properties are not derived in rrtmg_sw_cldprop       
+               elseif (icpr .eq. 0) then
+                  ztauo(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaua(ikl,ibm) + ptaucmc(ikl,iw)
+                  zomco(jk) = ptaua(ikl,ibm) * pomga(ikl,ibm) + ptaucmc(ikl,iw) * pomgcmc(ikl,iw) + &
+                              ztaur(ikl,iw) * 1.0_rb
+                  zgco (jk) = (ptaucmc(ikl,iw) * pomgcmc(ikl,iw) * pasycmc(ikl,iw) + &
+                              ptaua(ikl,ibm)*pomga(ikl,ibm)*pasya(ikl,ibm)) / zomco(jk)
+                  zomco(jk) = zomco(jk) / ztauo(jk)
+
+! Delta scaling - clouds 
+!   Use only if subroutine rrtmg_sw_cldprop is not used to get cloud properties and to apply delta scaling
+                  zf = zgco(jk) * zgco(jk)
+                  zwf = zomco(jk) * zf
+                  ztauo(jk) = (1._rb - zwf) * ztauo(jk)
+                  zomco(jk) = (zomco(jk) - zwf) / (1.0_rb - zwf)
+                  zgco (jk) = (zgco(jk) - zf) / (1.0_rb - zf)
+               endif 
+
+! End of layer loop
+            enddo    
+
+! Clear sky reflectivities
+            call reftra_sw (klev, &
+                            lrtchkclr, zgcc, prmu0, ztauc, zomcc, &
+                            zrefc, zrefdc, ztrac, ztradc)
+
+! Total sky reflectivities      
+            call reftra_sw (klev, &
+                            lrtchkcld, zgco, prmu0, ztauo, zomco, &
+                            zrefo, zrefdo, ztrao, ztrado)
+
+            do jk=1,klev
+
+! Combine clear and cloudy contributions for total sky
+               ikl = klev+1-jk 
+               zclear = 1.0_rb - pcldfmc(ikl,iw)
+               zcloud = pcldfmc(ikl,iw)
+
+               zref(jk) = zclear*zrefc(jk) + zcloud*zrefo(jk)
+               zrefd(jk)= zclear*zrefdc(jk) + zcloud*zrefdo(jk)
+               ztra(jk) = zclear*ztrac(jk) + zcloud*ztrao(jk)
+               ztrad(jk)= zclear*ztradc(jk) + zcloud*ztrado(jk)
+
+! Direct beam transmittance        
+
+! Clear
+!                zdbtmc = exp(-ztauc(jk) / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of 
+! exponential for low tau
+               ze1 = ztauc(jk) / prmu0
+               if (ze1 .le. od_lo) then
+                  zdbtmc = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+               else
+                  tblind = ze1 / (bpade + ze1)
+                  itind = tblint * tblind + 0.5_rb
+                  zdbtmc = exp_tbl(itind)
+               endif
+
+               zdbtc(jk) = zdbtmc
+               ztdbtc(jk+1) = zdbtc(jk)*ztdbtc(jk)
+
+! Clear + Cloud
+!                zdbtmo = exp(-ztauo(jk) / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of 
+! exponential for low tau
+               ze1 = ztauo(jk) / prmu0
+               if (ze1 .le. od_lo) then
+                  zdbtmo = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+               else
+                  tblind = ze1 / (bpade + ze1)
+                  itind = tblint * tblind + 0.5_rb
+                  zdbtmo = exp_tbl(itind)
+               endif
+
+               zdbt(jk) = zclear*zdbtmc + zcloud*zdbtmo
+               ztdbt(jk+1) = zdbt(jk)*ztdbt(jk)
+        
+            enddo           
+                 
+! Vertical quadrature for clear-sky fluxes
+
+            call vrtqdr_sw(klev, iw, &
+                           zrefc, zrefdc, ztrac, ztradc, &
+                           zdbtc, zrdndc, zrupc, zrupdc, ztdbtc, &
+                           zcd, zcu)
+      
+! Vertical quadrature for cloudy fluxes
+
+            call vrtqdr_sw(klev, iw, &
+                           zref, zrefd, ztra, ztrad, &
+                           zdbt, zrdnd, zrup, zrupd, ztdbt, &
+                           zfd, zfu)
+
+! 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
+
+            do jk=1,klev+1
+               ikl=klev+2-jk
+
+! Accumulate spectral fluxes over bands - inactive
+!               zbbfu(ikl) = zbbfu(ikl) + zincflx(iw)*zfu(jk,iw)  
+!               zbbfd(ikl) = zbbfd(ikl) + zincflx(iw)*zfd(jk,iw)
+!               zbbcu(ikl) = zbbcu(ikl) + zincflx(iw)*zcu(jk,iw)
+!               zbbcd(ikl) = zbbcd(ikl) + zincflx(iw)*zcd(jk,iw)
+!               zbbfddir(ikl) = zbbfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+!               zbbcddir(ikl) = zbbcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+
+! Accumulate spectral fluxes over whole spectrum  
+               pbbfu(ikl) = pbbfu(ikl) + zincflx(iw)*zfu(jk,iw)
+               pbbfd(ikl) = pbbfd(ikl) + zincflx(iw)*zfd(jk,iw)
+               pbbcu(ikl) = pbbcu(ikl) + zincflx(iw)*zcu(jk,iw)
+               pbbcd(ikl) = pbbcd(ikl) + zincflx(iw)*zcd(jk,iw)
+               if (idelm .eq. 0) then 
+                  pbbfddir(ikl) = pbbfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+                  pbbcddir(ikl) = pbbcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+               elseif (idelm .eq. 1) then
+                  pbbfddir(ikl) = pbbfddir(ikl) + zincflx(iw)*ztdbt(jk)
+                  pbbcddir(ikl) = pbbcddir(ikl) + zincflx(iw)*ztdbtc(jk)
+               endif
+
+! Accumulate direct fluxes for UV/visible bands
+               if (ibm >= 10 .and. ibm <= 13) then
+                  puvcd(ikl) = puvcd(ikl) + zincflx(iw)*zcd(jk,iw)
+                  puvfd(ikl) = puvfd(ikl) + zincflx(iw)*zfd(jk,iw)
+                  if (idelm .eq. 0) then 
+                     puvfddir(ikl) = puvfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+                     puvcddir(ikl) = puvcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+                  elseif (idelm .eq. 1) then
+                     puvfddir(ikl) = puvfddir(ikl) + zincflx(iw)*ztdbt(jk)
+                     puvcddir(ikl) = puvcddir(ikl) + zincflx(iw)*ztdbtc(jk)
+                  endif
+! Accumulate direct fluxes for near-IR bands
+               else if (ibm == 14 .or. ibm <= 9) then  
+                  pnicd(ikl) = pnicd(ikl) + zincflx(iw)*zcd(jk,iw)
+                  pnifd(ikl) = pnifd(ikl) + zincflx(iw)*zfd(jk,iw)
+                  if (idelm .eq. 0) then 
+                     pnifddir(ikl) = pnifddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+                     pnicddir(ikl) = pnicddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+                  elseif (idelm .eq. 1) then
+                     pnifddir(ikl) = pnifddir(ikl) + zincflx(iw)*ztdbt(jk)
+                     pnicddir(ikl) = pnicddir(ikl) + zincflx(iw)*ztdbtc(jk)
+                  endif
+               endif
+
+            enddo
+
+! End loop on jg, g-point interval
+         enddo             
+
+! End loop on jb, spectral band
+      enddo                    
+
+      end subroutine spcvmc_sw
+
+      end module rrtmg_sw_spcvmc
+
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_spcvrt.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_spcvrt.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_spcvrt.f90	(revision 1585)
@@ -0,0 +1,630 @@
+!     path:      $Source$
+!     author:    $Author: mike $
+!     revision:  $Revision: 11661 $
+!     created:   $Date: 2009-05-22 18:22:22 -0400 (Fri, 22 May 2009) $
+
+      module rrtmg_sw_spcvrt
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+      use parrrsw, only : nbndsw, ngptsw, mxmol, jpband
+      use rrsw_tbl, only : tblint, bpade, od_lo, exp_tbl
+      use rrsw_vsn, only : hvrspv, hnamspv
+      use rrsw_wvn, only : ngc, ngs
+      use rrtmg_sw_reftra, only: reftra_sw
+      use rrtmg_sw_taumol, only: taumol_sw
+      use rrtmg_sw_vrtqdr, only: vrtqdr_sw
+
+      implicit none
+
+      contains
+
+! ---------------------------------------------------------------------------
+      subroutine spcvrt_sw &
+            (nlayers, istart, iend, icpr, idelm, iout, &
+             pavel, tavel, pz, tz, tbound, palbd, palbp, &
+             pclfr, ptauc, pasyc, pomgc, ptaucorig, &
+             ptaua, pasya, pomga, prmu0, coldry, wkl, 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)
+! ---------------------------------------------------------------------------
+!
+! Purpose: Contains spectral loop to compute the shortwave radiative fluxes, 
+!          using the two-stream method of H. Barker. 
+!
+! Interface:  *spcvrt_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: Uniform formatting for RRTMG: MJIacono, AER, Jul 2006 
+! Revision: Use exponential lookup table for transmittance: MJIacono, AER, 
+!           Aug 2007 
+!
+! ------------------------------------------------------------------
+
+! ------- Declarations ------
+
+! -------- Input -------
+
+      integer(kind=im), intent(in) :: nlayers
+      integer(kind=im), intent(in) :: istart
+      integer(kind=im), intent(in) :: iend
+      integer(kind=im), intent(in) :: icpr
+      integer(kind=im), intent(in) :: idelm   ! delta-m scaling flag
+                                              ! [0 = direct and diffuse fluxes are unscaled]
+                                              ! [1 = direct and diffuse fluxes are scaled]
+      integer(kind=im), intent(in) :: iout
+      integer(kind=im), intent(in) :: laytrop
+      integer(kind=im), intent(in) :: layswtch
+      integer(kind=im), intent(in) :: laylow
+
+      integer(kind=im), intent(in) :: indfor(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: indself(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jp(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt(:)
+                                                               !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt1(:)
+                                                               !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: pavel(:)                    ! layer pressure (hPa, mb) 
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: tavel(:)                    ! layer temperature (K)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: pz(0:)                      ! level (interface) pressure (hPa, mb)
+                                                               !   Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tz(0:)                      ! level temperatures (hPa, mb)
+                                                               !   Dimensions: (0:nlayers)
+      real(kind=rb), intent(in) :: tbound                      ! surface temperature (K)
+      real(kind=rb), intent(in) :: wkl(:,:)                    ! molecular amounts (mol/cm2) 
+                                                               !   Dimensions: (mxmol,nlayers)
+      real(kind=rb), intent(in) :: coldry(:)                   ! dry air column density (mol/cm2)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colmol(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: adjflux(:)                  ! Earth/Sun distance adjustment
+                                                               !   Dimensions: (jpband)
+
+      real(kind=rb), intent(in) :: palbd(:)                    ! surface albedo (diffuse)
+                                                               !   Dimensions: (nbndsw)
+      real(kind=rb), intent(in) :: palbp(:)                    ! surface albedo (direct)
+                                                               !   Dimensions: (nbndsw)
+      real(kind=rb), intent(in) :: prmu0                       ! cosine of solar zenith angle
+      real(kind=rb), intent(in) :: pclfr(:)                    ! cloud fraction
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: ptauc(:,:)                  ! cloud optical depth
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: pasyc(:,:)                  ! cloud asymmetry parameter
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: pomgc(:,:)                  ! cloud single scattering albedo
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: ptaucorig(:,:)              ! cloud optical depth, non-delta scaled
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: ptaua(:,:)                  ! aerosol optical depth
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: pasya(:,:)                  ! aerosol asymmetry parameter
+                                                               !   Dimensions: (nlayers,nbndsw)
+      real(kind=rb), intent(in) :: pomga(:,:)                  ! aerosol single scattering albedo
+                                                               !   Dimensions: (nlayers,nbndsw)
+
+      real(kind=rb), intent(in) :: colh2o(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colco2(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colch4(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: co2mult(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo3(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo2(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: coln2o(:)
+                                                               !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: forfac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: forfrac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffrac(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac00(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac01(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac10(:)
+                                                               !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: fac11(:)
+                                                               !   Dimensions: (nlayers)
+
+! ------- Output -------
+                                                               !   All Dimensions: (nlayers+1)
+      real(kind=rb), intent(out) :: pbbcd(:)
+      real(kind=rb), intent(out) :: pbbcu(:)
+      real(kind=rb), intent(out) :: pbbfd(:)
+      real(kind=rb), intent(out) :: pbbfu(:)
+      real(kind=rb), intent(out) :: pbbfddir(:)
+      real(kind=rb), intent(out) :: pbbcddir(:)
+
+      real(kind=rb), intent(out) :: puvcd(:)
+      real(kind=rb), intent(out) :: puvfd(:)
+      real(kind=rb), intent(out) :: puvcddir(:)
+      real(kind=rb), intent(out) :: puvfddir(:)
+
+      real(kind=rb), intent(out) :: pnicd(:)
+      real(kind=rb), intent(out) :: pnifd(:)
+      real(kind=rb), intent(out) :: pnicddir(:)
+      real(kind=rb), intent(out) :: pnifddir(:)
+
+! Output - inactive                                            !   All Dimensions: (nlayers+1)
+!      real(kind=rb), intent(out) :: puvcu(:)
+!      real(kind=rb), intent(out) :: puvfu(:)
+!      real(kind=rb), intent(out) :: pnicu(:)
+!      real(kind=rb), intent(out) :: pnifu(:)
+!      real(kind=rb), intent(out) :: pvscd(:)
+!      real(kind=rb), intent(out) :: pvscu(:)
+!      real(kind=rb), intent(out) :: pvsfd(:)
+!      real(kind=rb), intent(out) :: pvsfu(:)
+
+
+! ------- Local -------
+
+      logical :: lrtchkclr(nlayers),lrtchkcld(nlayers)
+
+      integer(kind=im)  :: klev
+      integer(kind=im) :: ib1, ib2, ibm, igt, ikl, ikp, ikx
+      integer(kind=im) :: iw, jb, jg, jl, jk
+!      integer(kind=im), parameter :: nuv = ?? 
+!      integer(kind=im), parameter :: nvs = ?? 
+      integer(kind=im) :: itind
+
+      real(kind=rb) :: tblind, ze1
+      real(kind=rb) :: zclear, zcloud
+      real(kind=rb) :: zdbt(nlayers+1), zdbt_nodel(nlayers+1)
+      real(kind=rb) :: zgc(nlayers), zgcc(nlayers), zgco(nlayers)
+      real(kind=rb) :: zomc(nlayers), zomcc(nlayers), zomco(nlayers)
+      real(kind=rb) :: zrdnd(nlayers+1), zrdndc(nlayers+1)
+      real(kind=rb) :: zref(nlayers+1), zrefc(nlayers+1), zrefo(nlayers+1)
+      real(kind=rb) :: zrefd(nlayers+1), zrefdc(nlayers+1), zrefdo(nlayers+1)
+      real(kind=rb) :: zrup(nlayers+1), zrupd(nlayers+1)
+      real(kind=rb) :: zrupc(nlayers+1), zrupdc(nlayers+1)
+      real(kind=rb) :: zs1(nlayers+1)
+      real(kind=rb) :: ztauc(nlayers), ztauo(nlayers)
+      real(kind=rb) :: ztdn(nlayers+1), ztdnd(nlayers+1), ztdbt(nlayers+1)
+      real(kind=rb) :: ztoc(nlayers), ztor(nlayers)
+      real(kind=rb) :: ztra(nlayers+1), ztrac(nlayers+1), ztrao(nlayers+1)
+      real(kind=rb) :: ztrad(nlayers+1), ztradc(nlayers+1), ztrado(nlayers+1)
+      real(kind=rb) :: zdbtc(nlayers+1), ztdbtc(nlayers+1)
+      real(kind=rb) :: zincflx(ngptsw), zdbtc_nodel(nlayers+1) 
+      real(kind=rb) :: ztdbt_nodel(nlayers+1), ztdbtc_nodel(nlayers+1)
+
+      real(kind=rb) :: zdbtmc, zdbtmo, zf, zgw, zreflect
+      real(kind=rb) :: zwf, tauorig, repclc
+!     real(kind=rb) :: zincflux                                   ! inactive
+
+! Arrays from rrtmg_sw_taumoln routines
+
+!      real(kind=rb) :: ztaug(nlayers,16), ztaur(nlayers,16)
+!      real(kind=rb) :: zsflxzen(16)
+      real(kind=rb) :: ztaug(nlayers,ngptsw), ztaur(nlayers,ngptsw)
+      real(kind=rb) :: zsflxzen(ngptsw)
+
+! Arrays from rrtmg_sw_vrtqdr routine
+
+      real(kind=rb) :: zcd(nlayers+1,ngptsw), zcu(nlayers+1,ngptsw)
+      real(kind=rb) :: zfd(nlayers+1,ngptsw), zfu(nlayers+1,ngptsw)
+
+! Inactive arrays
+!     real(kind=rb) :: zbbcd(nlayers+1), zbbcu(nlayers+1)
+!     real(kind=rb) :: zbbfd(nlayers+1), zbbfu(nlayers+1)
+!     real(kind=rb) :: zbbfddir(nlayers+1), zbbcddir(nlayers+1)
+
+! ------------------------------------------------------------------
+
+! Initializations
+
+      ib1 = istart
+      ib2 = iend
+      klev = nlayers
+      iw = 0
+      repclc = 1.e-12_rb
+!      zincflux = 0.0_rb
+
+      do jk=1,klev+1
+         pbbcd(jk)=0._rb
+         pbbcu(jk)=0._rb
+         pbbfd(jk)=0._rb
+         pbbfu(jk)=0._rb
+         pbbcddir(jk)=0._rb
+         pbbfddir(jk)=0._rb
+         puvcd(jk)=0._rb
+         puvfd(jk)=0._rb
+         puvcddir(jk)=0._rb
+         puvfddir(jk)=0._rb
+         pnicd(jk)=0._rb
+         pnifd(jk)=0._rb
+         pnicddir(jk)=0._rb
+         pnifddir(jk)=0._rb
+      enddo
+
+
+! Calculate the optical depths for gaseous absorption and Rayleigh scattering
+
+      call taumol_sw(klev, &
+                     colh2o, colco2, colch4, colo2, colo3, colmol, &
+                     laytrop, jp, jt, jt1, &
+                     fac00, fac01, fac10, fac11, &
+                     selffac, selffrac, indself, forfac, forfrac, indfor, &
+                     zsflxzen, ztaug, ztaur)
+
+
+! Top of shortwave spectral band loop, jb = 16 -> 29; ibm = 1 -> 14
+
+      do jb = ib1, ib2
+         ibm = jb-15
+         igt = ngc(ibm)
+
+! Reinitialize g-point counter for each band if output for each band is requested.
+         if (iout.gt.0.and.ibm.ge.2) iw = ngs(ibm-1)
+
+!        do jk=1,klev+1
+!           zbbcd(jk)=0.0_rb
+!           zbbcu(jk)=0.0_rb
+!           zbbfd(jk)=0.0_rb
+!           zbbfu(jk)=0.0_rb
+!        enddo
+
+! Top of g-point interval loop within each band (iw is cumulative counter) 
+         do jg = 1,igt
+            iw = iw+1
+
+! Apply adjustments for correct Earth/Sun distance and zenith angle to incoming solar flux
+            zincflx(iw) = adjflux(jb) * zsflxzen(iw) * prmu0
+!             zincflux = zincflux + adjflux(jb) * zsflxzen(iw) * prmu0           ! inactive
+
+! Compute layer reflectances and transmittances for direct and diffuse sources, 
+! first clear then cloudy
+
+! zrefc(jk)  direct albedo for clear
+! zrefo(jk)  direct albedo for cloud
+! zrefdc(jk) diffuse albedo for clear
+! zrefdo(jk) diffuse albedo for cloud
+! ztrac(jk)  direct transmittance for clear
+! ztrao(jk)  direct transmittance for cloudy
+! ztradc(jk) diffuse transmittance for clear
+! ztrado(jk) diffuse transmittance for cloudy
+!  
+! zref(jk)   direct reflectance
+! zrefd(jk)  diffuse reflectance
+! ztra(jk)   direct transmittance
+! ztrad(jk)  diffuse transmittance
+!
+! zdbtc(jk)  clear direct beam transmittance
+! zdbto(jk)  cloudy direct beam transmittance
+! zdbt(jk)   layer mean direct beam transmittance
+! ztdbt(jk)  total direct beam transmittance at levels
+
+! Clear-sky    
+!   TOA direct beam    
+            ztdbtc(1)=1.0_rb
+            ztdbtc_nodel(1)=1.0_rb
+!   Surface values
+            zdbtc(klev+1) =0.0_rb
+            ztrac(klev+1) =0.0_rb
+            ztradc(klev+1)=0.0_rb
+            zrefc(klev+1) =palbp(ibm)
+            zrefdc(klev+1)=palbd(ibm)
+            zrupc(klev+1) =palbp(ibm)
+            zrupdc(klev+1)=palbd(ibm)
+           
+! Cloudy-sky    
+!   Surface values
+            ztrao(klev+1) =0.0_rb
+            ztrado(klev+1)=0.0_rb
+            zrefo(klev+1) =palbp(ibm)
+            zrefdo(klev+1)=palbd(ibm)
+           
+! Total sky    
+!   TOA direct beam    
+            ztdbt(1)=1.0_rb
+            ztdbt_nodel(1)=1.0_rb
+!   Surface values
+            zdbt(klev+1) =0.0_rb
+            ztra(klev+1) =0.0_rb
+            ztrad(klev+1)=0.0_rb
+            zref(klev+1) =palbp(ibm)
+            zrefd(klev+1)=palbd(ibm)
+            zrup(klev+1) =palbp(ibm)
+            zrupd(klev+1)=palbd(ibm)
+    
+    
+! Top of layer loop
+            do jk=1,klev
+
+! Note: two-stream calculations proceed from top to bottom; 
+!   RRTMG_SW quantities are given bottom to top and are reversed here
+
+               ikl=klev+1-jk
+
+! Set logical flag to do REFTRA calculation
+!   Do REFTRA for all clear layers
+               lrtchkclr(jk)=.true.
+
+!   Do REFTRA only for cloudy layers in profile, since already done for clear layers
+               lrtchkcld(jk)=.false.
+               lrtchkcld(jk)=(pclfr(ikl) > repclc)
+
+! Clear-sky optical parameters - this section inactive     
+!   Original
+!               ztauc(jk) = ztaur(ikl,iw) + ztaug(ikl,iw)
+!               zomcc(jk) = ztaur(ikl,iw) / ztauc(jk)
+!               zgcc(jk) = 0.0001_rb
+!   Total sky optical parameters        
+!               ztauo(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptauc(ikl,ibm)
+!               zomco(jk) = ptauc(ikl,ibm) * pomgc(ikl,ibm) + ztaur(ikl,iw)
+!               zgco (jk) = (ptauc(ikl,ibm) * pomgc(ikl,ibm) * pasyc(ikl,ibm) + &
+!                           ztaur(ikl,iw) * 0.0001_rb) / zomco(jk)
+!               zomco(jk) = zomco(jk) / ztauo(jk)
+
+! Clear-sky optical parameters including aerosols
+               ztauc(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaua(ikl,ibm)
+               zomcc(jk) = ztaur(ikl,iw) * 1.0_rb + ptaua(ikl,ibm) * pomga(ikl,ibm)
+               zgcc(jk) = pasya(ikl,ibm) * pomga(ikl,ibm) * ptaua(ikl,ibm) / zomcc(jk)
+               zomcc(jk) = zomcc(jk) / ztauc(jk)
+
+! Pre-delta-scaling clear and cloudy direct beam transmittance (must use 'orig', unscaled cloud OD)       
+!   \/\/\/ This block of code is only needed for unscaled direct beam calculation
+               if (idelm .eq. 0) then
+!     
+                  zclear = 1.0_rb - pclfr(ikl)
+                  zcloud = pclfr(ikl)
+
+! Clear
+!                   zdbtmc = exp(-ztauc(jk) / prmu0)
+ 
+! Use exponential lookup table for transmittance, or expansion of exponential for low tau
+                  ze1 = ztauc(jk) / prmu0
+                  if (ze1 .le. od_lo) then
+                     zdbtmc = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+                  else 
+                     tblind = ze1 / (bpade + ze1)
+                     itind = tblint * tblind + 0.5_rb
+                     zdbtmc = exp_tbl(itind)
+                  endif
+
+                  zdbtc_nodel(jk) = zdbtmc
+                  ztdbtc_nodel(jk+1) = zdbtc_nodel(jk) * ztdbtc_nodel(jk)
+
+! Clear + Cloud
+                  tauorig = ztauc(jk) + ptaucorig(ikl,ibm)
+!                   zdbtmo = exp(-tauorig / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of exponential for low tau
+                  ze1 = tauorig / prmu0
+                  if (ze1 .le. od_lo) then
+                     zdbtmo = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+                  else
+                     tblind = ze1 / (bpade + ze1)
+                     itind = tblint * tblind + 0.5_rb
+                     zdbtmo = exp_tbl(itind)
+                  endif
+
+                  zdbt_nodel(jk) = zclear * zdbtmc + zcloud * zdbtmo
+                  ztdbt_nodel(jk+1) = zdbt_nodel(jk) * ztdbt_nodel(jk)
+
+               endif
+!   /\/\/\ Above code only needed for unscaled direct beam calculation
+
+
+! Delta scaling - clear   
+               zf = zgcc(jk) * zgcc(jk)
+               zwf = zomcc(jk) * zf
+               ztauc(jk) = (1.0_rb - zwf) * ztauc(jk)
+               zomcc(jk) = (zomcc(jk) - zwf) / (1.0_rb - zwf)
+               zgcc (jk) = (zgcc(jk) - zf) / (1.0_rb - zf)
+
+! Total sky optical parameters (cloud properties already delta-scaled)
+!   Use this code if cloud properties are derived in rrtmg_sw_cldprop       
+               if (icpr .ge. 1) then
+                  ztauo(jk) = ztauc(jk) + ptauc(ikl,ibm)
+                  zomco(jk) = ztauc(jk) * zomcc(jk) + ptauc(ikl,ibm) * pomgc(ikl,ibm) 
+                  zgco (jk) = (ptauc(ikl,ibm) * pomgc(ikl,ibm) * pasyc(ikl,ibm) + &
+                              ztauc(jk) * zomcc(jk) * zgcc(jk)) / zomco(jk)
+                  zomco(jk) = zomco(jk) / ztauo(jk)
+
+! Total sky optical parameters (if cloud properties not delta scaled)
+!   Use this code if cloud properties are not derived in rrtmg_sw_cldprop       
+               elseif (icpr .eq. 0) then
+                  ztauo(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaua(ikl,ibm) + ptauc(ikl,ibm)
+                  zomco(jk) = ptaua(ikl,ibm) * pomga(ikl,ibm) + ptauc(ikl,ibm) * pomgc(ikl,ibm) + &
+                              ztaur(ikl,iw) * 1.0_rb
+                  zgco (jk) = (ptauc(ikl,ibm) * pomgc(ikl,ibm) * pasyc(ikl,ibm) + &
+                              ptaua(ikl,ibm)*pomga(ikl,ibm)*pasya(ikl,ibm)) / zomco(jk)
+                  zomco(jk) = zomco(jk) / ztauo(jk)
+
+! Delta scaling - clouds 
+!   Use only if subroutine rrtmg_sw_cldprop is not used to get cloud properties and to apply delta scaling
+                  zf = zgco(jk) * zgco(jk)
+                  zwf = zomco(jk) * zf
+                  ztauo(jk) = (1._rb - zwf) * ztauo(jk)
+                  zomco(jk) = (zomco(jk) - zwf) / (1.0_rb - zwf)
+                  zgco (jk) = (zgco(jk) - zf) / (1.0_rb - zf)
+               endif 
+
+! End of layer loop
+            enddo    
+
+
+! Clear sky reflectivities
+            call reftra_sw (klev, &
+                            lrtchkclr, zgcc, prmu0, ztauc, zomcc, &
+                            zrefc, zrefdc, ztrac, ztradc)
+
+! Total sky reflectivities      
+            call reftra_sw (klev, &
+                            lrtchkcld, zgco, prmu0, ztauo, zomco, &
+                            zrefo, zrefdo, ztrao, ztrado)
+
+
+            do jk=1,klev
+
+! Combine clear and cloudy contributions for total sky
+               ikl = klev+1-jk 
+               zclear = 1.0_rb - pclfr(ikl)
+               zcloud = pclfr(ikl)
+
+               zref(jk) = zclear*zrefc(jk) + zcloud*zrefo(jk)
+               zrefd(jk)= zclear*zrefdc(jk) + zcloud*zrefdo(jk)
+               ztra(jk) = zclear*ztrac(jk) + zcloud*ztrao(jk)
+               ztrad(jk)= zclear*ztradc(jk) + zcloud*ztrado(jk)
+
+! Direct beam transmittance        
+
+! Clear
+!                zdbtmc = exp(-ztauc(jk) / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of 
+! exponential for low tau
+               ze1 = ztauc(jk) / prmu0
+               if (ze1 .le. od_lo) then
+                  zdbtmc = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+               else
+                  tblind = ze1 / (bpade + ze1)
+                  itind = tblint * tblind + 0.5_rb
+                  zdbtmc = exp_tbl(itind)
+               endif
+
+               zdbtc(jk) = zdbtmc
+               ztdbtc(jk+1) = zdbtc(jk)*ztdbtc(jk)
+
+! Clear + Cloud
+!                zdbtmo = exp(-ztauo(jk) / prmu0)
+
+! Use exponential lookup table for transmittance, or expansion of 
+! exponential for low tau
+               ze1 = ztauo(jk) / prmu0
+               if (ze1 .le. od_lo) then
+                  zdbtmo = 1._rb - ze1 + 0.5_rb * ze1 * ze1
+               else
+                  tblind = ze1 / (bpade + ze1)
+                  itind = tblint * tblind + 0.5_rb
+                  zdbtmo = exp_tbl(itind)
+               endif
+
+               zdbt(jk) = zclear*zdbtmc + zcloud*zdbtmo
+               ztdbt(jk+1) = zdbt(jk)*ztdbt(jk)
+        
+            enddo           
+                 
+! Vertical quadrature for clear-sky fluxes
+
+            call vrtqdr_sw (klev, iw, &
+                            zrefc, zrefdc, ztrac, ztradc, &
+                            zdbtc, zrdndc, zrupc, zrupdc, ztdbtc, &
+                            zcd, zcu)
+      
+! Vertical quadrature for cloudy fluxes
+
+            call vrtqdr_sw (klev, iw, &
+                            zref, zrefd, ztra, ztrad, &
+                            zdbt, zrdnd, zrup, zrupd, ztdbt, &
+                            zfd, zfu)
+
+! 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
+
+            do jk=1,klev+1
+               ikl=klev+2-jk
+
+! Accumulate spectral fluxes over bands - inactive
+!               zbbfu(ikl) = zbbfu(ikl) + zincflx(iw)*zfu(jk,iw)  
+!               zbbfd(ikl) = zbbfd(ikl) + zincflx(iw)*zfd(jk,iw)
+!               zbbcu(ikl) = zbbcu(ikl) + zincflx(iw)*zcu(jk,iw)
+!               zbbcd(ikl) = zbbcd(ikl) + zincflx(iw)*zcd(jk,iw)
+!               zbbfddir(ikl) = zbbfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+!               zbbcddir(ikl) = zbbcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+
+! Accumulate spectral fluxes over whole spectrum  
+               pbbfu(ikl) = pbbfu(ikl) + zincflx(iw)*zfu(jk,iw)
+               pbbfd(ikl) = pbbfd(ikl) + zincflx(iw)*zfd(jk,iw)
+               pbbcu(ikl) = pbbcu(ikl) + zincflx(iw)*zcu(jk,iw)
+               pbbcd(ikl) = pbbcd(ikl) + zincflx(iw)*zcd(jk,iw)
+               if (idelm .eq. 0) then 
+                  pbbfddir(ikl) = pbbfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+                  pbbcddir(ikl) = pbbcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+               elseif (idelm .eq. 1) then
+                  pbbfddir(ikl) = pbbfddir(ikl) + zincflx(iw)*ztdbt(jk)
+                  pbbcddir(ikl) = pbbcddir(ikl) + zincflx(iw)*ztdbtc(jk)
+               endif
+
+! Accumulate direct fluxes for UV/visible bands
+               if (ibm >= 10 .and. ibm <= 13) then
+                  puvcd(ikl) = puvcd(ikl) + zincflx(iw)*zcd(jk,iw)
+                  puvfd(ikl) = puvfd(ikl) + zincflx(iw)*zfd(jk,iw)
+                  if (idelm .eq. 0) then 
+                     puvfddir(ikl) = puvfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+                     puvcddir(ikl) = puvcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+                  elseif (idelm .eq. 1) then
+                     puvfddir(ikl) = puvfddir(ikl) + zincflx(iw)*ztdbt(jk)
+                     puvcddir(ikl) = puvcddir(ikl) + zincflx(iw)*ztdbtc(jk)
+                  endif
+! Accumulate direct fluxes for near-IR bands
+               else if (ibm == 14 .or. ibm <= 9) then  
+                  pnicd(ikl) = pnicd(ikl) + zincflx(iw)*zcd(jk,iw)
+                  pnifd(ikl) = pnifd(ikl) + zincflx(iw)*zfd(jk,iw)
+                  if (idelm .eq. 0) then 
+                     pnifddir(ikl) = pnifddir(ikl) + zincflx(iw)*ztdbt_nodel(jk)
+                     pnicddir(ikl) = pnicddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk)
+                  elseif (idelm .eq. 1) then
+                     pnifddir(ikl) = pnifddir(ikl) + zincflx(iw)*ztdbt(jk)
+                     pnicddir(ikl) = pnicddir(ikl) + zincflx(iw)*ztdbtc(jk)
+                  endif
+               endif
+
+            enddo
+
+! End loop on jg, g-point interval
+         enddo             
+
+! End loop on jb, spectral band
+      enddo                    
+
+      end subroutine spcvrt_sw
+
+      end module rrtmg_sw_spcvrt
+
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_taumol.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_taumol.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_taumol.f90	(revision 1585)
@@ -0,0 +1,1541 @@
+!     path:      $Source$
+!     author:    $Author: mike $
+!     revision:  $Revision: 11661 $
+!     created:   $Date: 2009-05-22 18:22:22 -0400 (Fri, 22 May 2009) $
+
+      module rrtmg_sw_taumol
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only : im => kind_im, rb => kind_rb
+!      use parrrsw, only : mg, jpband, nbndsw, ngptsw
+      use rrsw_con, only: oneminus
+      use rrsw_wvn, only: nspa, nspb
+      use rrsw_vsn, only: hvrtau, hnamtau
+
+      implicit none
+
+      contains
+
+!----------------------------------------------------------------------------
+      subroutine taumol_sw(nlayers, &
+                           colh2o, colco2, colch4, colo2, colo3, colmol, &
+                           laytrop, jp, jt, jt1, &
+                           fac00, fac01, fac10, fac11, &
+                           selffac, selffrac, indself, forfac, forfrac, indfor, &
+                           sfluxzen, taug, taur)
+!----------------------------------------------------------------------------
+
+! ******************************************************************************
+! *                                                                            *
+! *                 Optical depths developed for the                           *
+! *                                                                            *
+! *               RAPID RADIATIVE TRANSFER MODEL (RRTM)                        *
+! *                                                                            *
+! *                                                                            *
+! *           ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC.                     *
+! *                       131 HARTWELL AVENUE                                  *
+! *                       LEXINGTON, MA 02421                                  *
+! *                                                                            *
+! *                                                                            *
+! *                          ELI J. MLAWER                                     *
+! *                        JENNIFER DELAMERE                                   *
+! *                        STEVEN J. TAUBMAN                                   *
+! *                        SHEPARD A. CLOUGH                                   *
+! *                                                                            *
+! *                                                                            *
+! *                                                                            *
+! *                                                                            *
+! *                      email:  mlawer@aer.com                                *
+! *                      email:  jdelamer@aer.com                              *
+! *                                                                            *
+! *       The authors wish to acknowledge the contributions of the             *
+! *       following people:  Patrick D. Brown, Michael J. Iacono,              *
+! *       Ronald E. Farren, Luke Chen, Robert Bergstrom.                       *
+! *                                                                            *
+! ******************************************************************************
+! *    TAUMOL                                                                  *
+! *                                                                            *
+! *    This file contains the subroutines TAUGBn (where n goes from            *
+! *    1 to 28).  TAUGBn calculates the optical depths and Planck fractions    *
+! *    per g-value and layer for band n.                                       *
+! *                                                                            *
+! * Output:  optical depths (unitless)                                         *
+! *          fractions needed to compute Planck functions at every layer       *
+! *              and g-value                                                   *
+! *                                                                            *
+! *    COMMON /TAUGCOM/  TAUG(MXLAY,MG)                                        *
+! *    COMMON /PLANKG/   FRACS(MXLAY,MG)                                       *
+! *                                                                            *
+! * Input                                                                      *
+! *                                                                            *
+! *    PARAMETER (MG=16, MXLAY=203, NBANDS=14)                                 *
+! *                                                                            *
+! *    COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)                  *
+! *    COMMON /PRECISE/  ONEMINUS                                              *
+! *    COMMON /PROFILE/  NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY),                    *
+! *   &                  PZ(0:MXLAY),TZ(0:MXLAY),TBOUND                        *
+! *    COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW,                              *
+! *   &                  COLH2O(MXLAY),COLCO2(MXLAY),                          *
+! *   &                  COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY),             *
+! *   &                  COLO2(MXLAY),CO2MULT(MXLAY)                           *
+! *    COMMON /INTFAC/   FAC00(MXLAY),FAC01(MXLAY),                            *
+! *   &                  FAC10(MXLAY),FAC11(MXLAY)                             *
+! *    COMMON /INTIND/   JP(MXLAY),JT(MXLAY),JT1(MXLAY)                        *
+! *    COMMON /SELF/     SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY)       *
+! *                                                                            *
+! *    Description:                                                            *
+! *    NG(IBAND) - number of g-values in band IBAND                            *
+! *    NSPA(IBAND) - for the lower atmosphere, the number of reference         *
+! *                  atmospheres that are stored for band IBAND per            *
+! *                  pressure level and temperature.  Each of these            *
+! *                  atmospheres has different relative amounts of the         *
+! *                  key species for the band (i.e. different binary           *
+! *                  species parameters).                                      *
+! *    NSPB(IBAND) - same for upper atmosphere                                 *
+! *    ONEMINUS - since problems are caused in some cases by interpolation     *
+! *               parameters equal to or greater than 1, for these cases       *
+! *               these parameters are set to this value, slightly < 1.        *
+! *    PAVEL - layer pressures (mb)                                            *
+! *    TAVEL - layer temperatures (degrees K)                                  *
+! *    PZ - level pressures (mb)                                               *
+! *    TZ - level temperatures (degrees K)                                     *
+! *    LAYTROP - layer at which switch is made from one combination of         *
+! *              key species to another                                        *
+! *    COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water         *
+! *              vapor,carbon dioxide, ozone, nitrous ozide, methane,          *
+! *              respectively (molecules/cm**2)                                *
+! *    CO2MULT - for bands in which carbon dioxide is implemented as a         *
+! *              trace species, this is the factor used to multiply the        *
+! *              band's average CO2 absorption coefficient to get the added    *
+! *              contribution to the optical depth relative to 355 ppm.        *
+! *    FACij(LAY) - for layer LAY, these are factors that are needed to        *
+! *                 compute the interpolation factors that multiply the        *
+! *                 appropriate reference k-values.  A value of 0 (1) for      *
+! *                 i,j indicates that the corresponding factor multiplies     *
+! *                 reference k-value for the lower (higher) of the two        *
+! *                 appropriate temperatures, and altitudes, respectively.     *
+! *    JP - the index of the lower (in altitude) of the two appropriate        *
+! *         reference pressure levels needed for interpolation                 *
+! *    JT, JT1 - the indices of the lower of the two appropriate reference     *
+! *              temperatures needed for interpolation (for pressure           *
+! *              levels JP and JP+1, respectively)                             *
+! *    SELFFAC - scale factor needed to water vapor self-continuum, equals     *
+! *              (water vapor density)/(atmospheric density at 296K and        *
+! *              1013 mb)                                                      *
+! *    SELFFRAC - factor needed for temperature interpolation of reference     *
+! *               water vapor self-continuum data                              *
+! *    INDSELF - index of the lower of the two appropriate reference           *
+! *              temperatures needed for the self-continuum interpolation      *
+! *                                                                            *
+! * Data input                                                                 *
+! *    COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) *
+! *       (note:  n is the band number)                                        *
+! *                                                                            *
+! *    Description:                                                            *
+! *    KA - k-values for low reference atmospheres (no water vapor             *
+! *         self-continuum) (units: cm**2/molecule)                            *
+! *    KB - k-values for high reference atmospheres (all sources)              *
+! *         (units: cm**2/molecule)                                            *
+! *    SELFREF - k-values for water vapor self-continuum for reference         *
+! *              atmospheres (used below LAYTROP)                              *
+! *              (units: cm**2/molecule)                                       *
+! *                                                                            *
+! *    DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG)                     *
+! *    EQUIVALENCE (KA,ABSA),(KB,ABSB)                                         *
+! *                                                                            *
+! *****************************************************************************
+!
+! Modifications
+!
+! Revised: Adapted to F90 coding, J.-J.Morcrette, ECMWF, Feb 2003
+! Revised: Modified for g-point reduction, MJIacono, AER, Dec 2003
+! Revised: Reformatted for consistency with rrtmg_lw, MJIacono, AER, Jul 2006
+!
+! ------- Declarations -------
+
+! ----- Input -----
+      integer(kind=im), intent(in) :: nlayers            ! total number of layers
+
+      integer(kind=im), intent(in) :: laytrop            ! tropopause layer index
+      integer(kind=im), intent(in) :: jp(:)              ! 
+                                                         !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt(:)              !
+                                                         !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: jt1(:)             !
+                                                         !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: colh2o(:)             ! column amount (h2o)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colco2(:)             ! column amount (co2)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo3(:)              ! column amount (o3)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colch4(:)             ! column amount (ch4)
+                                                         !   Dimensions: (nlayers)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colo2(:)              ! column amount (o2)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: colmol(:)             ! 
+                                                         !   Dimensions: (nlayers)
+
+      integer(kind=im), intent(in) :: indself(:)    
+                                                         !   Dimensions: (nlayers)
+      integer(kind=im), intent(in) :: indfor(:)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffac(:)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: selffrac(:)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: forfac(:)
+                                                         !   Dimensions: (nlayers)
+      real(kind=rb), intent(in) :: forfrac(:)
+                                                         !   Dimensions: (nlayers)
+
+      real(kind=rb), intent(in) :: &                     !
+                       fac00(:), fac01(:), &             !   Dimensions: (nlayers)
+                       fac10(:), fac11(:) 
+
+! ----- Output -----
+      real(kind=rb), intent(out) :: sfluxzen(:)          ! solar source function
+                                                         !   Dimensions: (ngptsw)
+      real(kind=rb), intent(out) :: taug(:,:)            ! gaseous optical depth 
+                                                         !   Dimensions: (nlayers,ngptsw)
+      real(kind=rb), intent(out) :: taur(:,:)            ! Rayleigh 
+                                                         !   Dimensions: (nlayers,ngptsw)
+!      real(kind=rb), intent(out) :: ssa(:,:)            ! single scattering albedo (inactive)
+                                                         !   Dimensions: (nlayers,ngptsw)
+
+      hvrtau = '$Revision: 11661 $'
+
+! Calculate gaseous optical depth and planck fractions for each spectral band.
+
+      call taumol16
+      call taumol17
+      call taumol18
+      call taumol19
+      call taumol20
+      call taumol21
+      call taumol22
+      call taumol23
+      call taumol24
+      call taumol25
+      call taumol26
+      call taumol27
+      call taumol28
+      call taumol29
+
+!-------------
+      contains
+!-------------
+
+!----------------------------------------------------------------------------
+      subroutine taumol16
+!----------------------------------------------------------------------------
+!
+!     band 16:  2600-3250 cm-1 (low - h2o,ch4; high - ch4)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng16
+      use rrsw_kg16, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat1
+
+! 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.  
+
+      strrat1 = 252.131_rb
+      layreffr = 18
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         speccomb = colh2o(lay) + strrat1*colch4(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng16
+            taug(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(lay) * &
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) 
+!            ssa(lay,ig) = tauray/taug(lay,ig)
+            taur(lay,ig) = tauray
+         enddo
+      enddo
+
+      laysolfr = nlayers
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
+            laysolfr = lay
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(16) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(16) + 1
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng16
+            taug(lay,ig) = colch4(lay) * &
+                (fac00(lay) * absb(ind0  ,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1  ,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) 
+!            ssa(lay,ig) = tauray/taug(lay,ig)
+            if (lay .eq. laysolfr) sfluxzen(ig) = sfluxref(ig) 
+            taur(lay,ig) = tauray  
+         enddo
+      enddo
+
+      end subroutine taumol16
+
+!----------------------------------------------------------------------------
+      subroutine taumol17
+!----------------------------------------------------------------------------
+!
+!     band 17:  3250-4000 cm-1 (low - h2o,co2; high - h2o,co2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng17, ngs16
+      use rrsw_kg17, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat
+
+! 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.364641_rb
+      layreffr = 30
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         speccomb = colh2o(lay) + strrat*colco2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(17) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(17) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng17
+            taug(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(lay) * &
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) 
+!             ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
+            taur(lay,ngs16+ig) = tauray
+         enddo
+      enddo
+
+      laysolfr = nlayers
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
+            laysolfr = lay
+         speccomb = colh2o(lay) + strrat*colco2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 4._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(17) + js
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(17) + js
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng17
+            taug(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(lay) * &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))) 
+!            ssa(lay,ngs16+ig) = tauray/taug(lay,ngs16+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs16+ig) = sfluxref(ig,js) &
+               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs16+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol17
+
+!----------------------------------------------------------------------------
+      subroutine taumol18
+!----------------------------------------------------------------------------
+!
+!     band 18:  4000-4650 cm-1 (low - h2o,ch4; high - ch4)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng18, ngs17
+      use rrsw_kg18, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat
+
+! 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 = 38.9589_rb
+      layreffr = 6
+      laysolfr = laytrop
+      
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         speccomb = colh2o(lay) + strrat*colch4(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(18) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(18) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng18
+            taug(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(lay) * &
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) 
+!            ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs17+ig) = sfluxref(ig,js) &
+               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs17+ig) = tauray
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(18) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(18) + 1
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng18
+            taug(lay,ngs17+ig) = colch4(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &	  
+                 fac11(lay) * absb(ind1+1,ig)) 
+!           ssa(lay,ngs17+ig) = tauray/taug(lay,ngs17+ig)
+           taur(lay,ngs17+ig) = tauray
+         enddo
+       enddo
+
+       end subroutine taumol18
+
+!----------------------------------------------------------------------------
+      subroutine taumol19
+!----------------------------------------------------------------------------
+!
+!     band 19:  4650-5150 cm-1 (low - h2o,co2; high - co2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng19, ngs18
+      use rrsw_kg19, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat
+
+! 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 = 5.49281_rb
+      layreffr = 3
+      laysolfr = laytrop
+
+! Lower atmosphere loop      
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         speccomb = colh2o(lay) + strrat*colco2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(19) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(19) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1 , ng19
+            taug(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(lay) * &
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + & 
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) 
+!            ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs18+ig) = sfluxref(ig,js) &
+               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs18+ig) = tauray   
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(19) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(19) + 1
+         tauray = colmol(lay) * rayl
+
+         do ig = 1 , ng19
+            taug(lay,ngs18+ig) = colco2(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) 
+!            ssa(lay,ngs18+ig) = tauray/taug(lay,ngs18+ig) 
+            taur(lay,ngs18+ig) = tauray   
+         enddo
+      enddo
+
+      end subroutine taumol19
+
+!----------------------------------------------------------------------------
+      subroutine taumol20
+!----------------------------------------------------------------------------
+!
+!     band 20:  5150-6150 cm-1 (low - h2o; high - h2o)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng20, ngs19
+      use rrsw_kg20, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, absch4, rayl
+
+      implicit none
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray
+
+! 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 = 3
+      laysolfr = laytrop
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(20) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(20) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng20
+            taug(lay,ngs19+ig) = colh2o(lay) * &
+               ((fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) + &
+                 selffac(lay) * (selfref(inds,ig) + & 
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) &
+                 + colch4(lay) * absch4(ig)
+!            ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
+            taur(lay,ngs19+ig) = tauray 
+            if (lay .eq. laysolfr) sfluxzen(ngs19+ig) = sfluxref(ig) 
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(20) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(20) + 1
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng20
+            taug(lay,ngs19+ig) = colh2o(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) + &
+                 colch4(lay) * absch4(ig)
+!            ssa(lay,ngs19+ig) = tauray/taug(lay,ngs19+ig)
+            taur(lay,ngs19+ig) = tauray 
+         enddo
+      enddo
+
+      end subroutine taumol20
+
+!----------------------------------------------------------------------------
+      subroutine taumol21
+!----------------------------------------------------------------------------
+!
+!     band 21:  6150-7700 cm-1 (low - h2o,co2; high - h2o,co2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng21, ngs20
+      use rrsw_kg21, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat
+
+! 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.0045321_rb
+      layreffr = 8
+      laysolfr = laytrop
+      
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         speccomb = colh2o(lay) + strrat*colco2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(21) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(21) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng21
+            taug(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(lay) * &
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))))
+!            ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs20+ig) = sfluxref(ig,js) &
+               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs20+ig) = tauray
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         speccomb = colh2o(lay) + strrat*colco2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 4._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(21) + js
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(21) + js
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng21
+            taug(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(lay) * &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))
+!            ssa(lay,ngs20+ig) = tauray/taug(lay,ngs20+ig)
+            taur(lay,ngs20+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol21
+
+!----------------------------------------------------------------------------
+      subroutine taumol22
+!----------------------------------------------------------------------------
+!
+!     band 22:  7700-8050 cm-1 (low - h2o,o2; high - o2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng22, ngs21
+      use rrsw_kg22, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, o2adj, o2cont, strrat
+
+! 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_rb
+      
+! 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_rb
+      layreffr = 2
+      laysolfr = laytrop
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         o2cont = 4.35e-4_rb*colo2(lay)/(350.0_rb*2.0_rb)
+         speccomb = colh2o(lay) + o2adj*strrat*colo2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+!         odadj = specparm + o2adj * (1._rb - specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(22) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(22) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng22
+            taug(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(lay) * &
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                  (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) &
+                 + o2cont
+!            ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs21+ig) = sfluxref(ig,js) &
+                + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs21+ig) = tauray
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         o2cont = 4.35e-4_rb*colo2(lay)/(350.0_rb*2.0_rb)
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(22) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(22) + 1
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng22
+            taug(lay,ngs21+ig) = colo2(lay) * o2adj * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) + &
+                 o2cont
+!            ssa(lay,ngs21+ig) = tauray/taug(lay,ngs21+ig)
+            taur(lay,ngs21+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol22
+
+!----------------------------------------------------------------------------
+      subroutine taumol23
+!----------------------------------------------------------------------------
+!
+!     band 23:  8050-12850 cm-1 (low - h2o; high - nothing)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng23, ngs22
+      use rrsw_kg23, only : absa, ka, forref, selfref, &
+                            sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, givfac
+
+! Average Giver et al. correction factor for this band.
+      givfac = 1.029_rb
+
+! 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
+      laysolfr = laytrop
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(23) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(23) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+
+         do ig = 1, ng23
+            tauray = colmol(lay) * rayl(ig)
+            taug(lay,ngs22+ig) = colh2o(lay) * &
+                (givfac * (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) + &
+                 selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + &
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) 
+!            ssa(lay,ngs22+ig) = tauray/taug(lay,ngs22+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs22+ig) = sfluxref(ig) 
+            taur(lay,ngs22+ig) = tauray
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         do ig = 1, ng23
+!            taug(lay,ngs22+ig) = colmol(lay) * rayl(ig)
+!            ssa(lay,ngs22+ig) = 1.0_rb
+            taug(lay,ngs22+ig) = 0._rb
+            taur(lay,ngs22+ig) = colmol(lay) * rayl(ig) 
+         enddo
+      enddo
+
+      end subroutine taumol23
+
+!----------------------------------------------------------------------------
+      subroutine taumol24
+!----------------------------------------------------------------------------
+!
+!     band 24:  12850-16000 cm-1 (low - h2o,o2; high - o2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng24, ngs23
+      use rrsw_kg24, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, abso3a, abso3b, rayla, raylb
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat
+
+! 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.124692_rb
+      layreffr = 1
+      laysolfr = laytrop
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         speccomb = colh2o(lay) + strrat*colo2(lay)
+         specparm = colh2o(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(24) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(24) + js
+         inds = indself(lay)
+         indf = indfor(lay)
+
+         do ig = 1, ng24
+            tauray = colmol(lay) * (rayla(ig,js) + &
+               fs * (rayla(ig,js+1) - rayla(ig,js)))
+            taug(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(lay) * abso3a(ig) + &
+                 colh2o(lay) * & 
+                 (selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + & 
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig))))
+!            ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs23+ig) = sfluxref(ig,js) &
+               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs23+ig) = tauray
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(24) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(24) + 1
+
+         do ig = 1, ng24
+            tauray = colmol(lay) * raylb(ig)
+            taug(lay,ngs23+ig) = colo2(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) + &
+                 colo3(lay) * abso3b(ig)
+!            ssa(lay,ngs23+ig) = tauray/taug(lay,ngs23+ig)
+            taur(lay,ngs23+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol24
+
+!----------------------------------------------------------------------------
+      subroutine taumol25
+!----------------------------------------------------------------------------
+!
+!     band 25:  16000-22650 cm-1 (low - h2o; high - nothing)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng25, ngs24
+      use rrsw_kg25, only : absa, ka, &
+                            sfluxref, abso3a, abso3b, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray
+
+! 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
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         if (jp(lay) .lt. layreffr .and. jp(lay+1) .ge. layreffr) &
+            laysolfr = min(lay+1,laytrop)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(25) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(25) + 1
+
+         do ig = 1, ng25
+            tauray = colmol(lay) * rayl(ig)
+            taug(lay,ngs24+ig) = colh2o(lay) * &
+                (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) + &
+                 colo3(lay) * abso3a(ig) 
+!            ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs24+ig) = sfluxref(ig) 
+            taur(lay,ngs24+ig) = tauray
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         do ig = 1, ng25
+            tauray = colmol(lay) * rayl(ig)
+            taug(lay,ngs24+ig) = colo3(lay) * abso3b(ig) 
+!            ssa(lay,ngs24+ig) = tauray/taug(lay,ngs24+ig)
+            taur(lay,ngs24+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol25
+
+!----------------------------------------------------------------------------
+      subroutine taumol26
+!----------------------------------------------------------------------------
+!
+!     band 26:  22650-29000 cm-1 (low - nothing; high - nothing)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng26, ngs25
+      use rrsw_kg26, only : sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray
+
+! 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
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         do ig = 1, ng26 
+!            taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
+!            ssa(lay,ngs25+ig) = 1.0_rb
+            if (lay .eq. laysolfr) sfluxzen(ngs25+ig) = sfluxref(ig) 
+            taug(lay,ngs25+ig) = 0._rb
+            taur(lay,ngs25+ig) = colmol(lay) * rayl(ig) 
+         enddo
+      enddo
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         do ig = 1, ng26
+!            taug(lay,ngs25+ig) = colmol(lay) * rayl(ig)
+!            ssa(lay,ngs25+ig) = 1.0_rb
+            taug(lay,ngs25+ig) = 0._rb
+            taur(lay,ngs25+ig) = colmol(lay) * rayl(ig) 
+         enddo
+      enddo
+
+      end subroutine taumol26
+
+!----------------------------------------------------------------------------
+      subroutine taumol27
+!----------------------------------------------------------------------------
+!
+!     band 27:  29000-38000 cm-1 (low - o3; high - o3)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng27, ngs26
+      use rrsw_kg27, only : absa, ka, absb, kb, sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, scalekur
+
+! 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_rb/48.37_rb
+
+! 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
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(27) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(27) + 1
+
+         do ig = 1, ng27
+            tauray = colmol(lay) * rayl(ig)
+            taug(lay,ngs26+ig) = colo3(lay) * &
+                (fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig))
+!            ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
+            taur(lay,ngs26+ig) = tauray
+         enddo
+      enddo
+
+      laysolfr = nlayers
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
+            laysolfr = lay
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(27) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(27) + 1
+
+         do ig = 1, ng27
+            tauray = colmol(lay) * rayl(ig)
+            taug(lay,ngs26+ig) = colo3(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + & 
+                 fac11(lay) * absb(ind1+1,ig))
+!            ssa(lay,ngs26+ig) = tauray/taug(lay,ngs26+ig)
+            if (lay.eq.laysolfr) sfluxzen(ngs26+ig) = scalekur * sfluxref(ig) 
+            taur(lay,ngs26+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol27
+
+!----------------------------------------------------------------------------
+      subroutine taumol28
+!----------------------------------------------------------------------------
+!
+!     band 28:  38000-50000 cm-1 (low - o3,o2; high - o3,o2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng28, ngs27
+      use rrsw_kg28, only : absa, ka, absb, kb, sfluxref, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray, strrat
+
+! 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_rb
+      layreffr = 58
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         speccomb = colo3(lay) + strrat*colo2(lay)
+         specparm = colo3(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 8._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(28) + js
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(28) + js
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng28
+            taug(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(lay,ngs27+ig) = tauray
+         enddo
+      enddo
+
+      laysolfr = nlayers
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
+            laysolfr = lay
+         speccomb = colo3(lay) + strrat*colo2(lay)
+         specparm = colo3(lay)/speccomb 
+         if (specparm .ge. oneminus) specparm = oneminus
+         specmult = 4._rb*(specparm)
+         js = 1 + int(specmult)
+         fs = mod(specmult, 1._rb )
+         fac000 = (1._rb - fs) * fac00(lay)
+         fac010 = (1._rb - fs) * fac10(lay)
+         fac100 = fs * fac00(lay)
+         fac110 = fs * fac10(lay)
+         fac001 = (1._rb - fs) * fac01(lay)
+         fac011 = (1._rb - fs) * fac11(lay)
+         fac101 = fs * fac01(lay)
+         fac111 = fs * fac11(lay)
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(28) + js
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(28) + js
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng28
+            taug(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(ngs27+ig) = sfluxref(ig,js) &
+               + fs * (sfluxref(ig,js+1) - sfluxref(ig,js))
+            taur(lay,ngs27+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol28
+
+!----------------------------------------------------------------------------
+      subroutine taumol29
+!----------------------------------------------------------------------------
+!
+!     band 29:  820-2600 cm-1 (low - h2o; high - co2)
+!
+!----------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parrrsw, only : ng29, ngs28
+      use rrsw_kg29, only : absa, ka, absb, kb, forref, selfref, &
+                            sfluxref, absh2o, absco2, rayl
+
+! ------- Declarations -------
+
+! Local
+
+      integer(kind=im) :: ig, ind0, ind1, inds, indf, js, lay, laysolfr, &
+                          layreffr
+      real(kind=rb) :: fac000, fac001, fac010, fac011, fac100, fac101, &
+                       fac110, fac111, fs, speccomb, specmult, specparm, &
+                       tauray
+
+! 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 = 49
+
+! Lower atmosphere loop
+      do lay = 1, laytrop
+         ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(29) + 1
+         ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(29) + 1
+         inds = indself(lay)
+         indf = indfor(lay)
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng29
+            taug(lay,ngs28+ig) = colh2o(lay) * &
+               ((fac00(lay) * absa(ind0,ig) + &
+                 fac10(lay) * absa(ind0+1,ig) + &
+                 fac01(lay) * absa(ind1,ig) + &
+                 fac11(lay) * absa(ind1+1,ig)) + &
+                 selffac(lay) * (selfref(inds,ig) + &
+                 selffrac(lay) * &
+                 (selfref(inds+1,ig) - selfref(inds,ig))) + &
+                 forfac(lay) * (forref(indf,ig) + & 
+                 forfrac(lay) * &
+                 (forref(indf+1,ig) - forref(indf,ig)))) &
+                 + colco2(lay) * absco2(ig) 
+!            ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
+            taur(lay,ngs28+ig) = tauray
+         enddo
+      enddo
+
+      laysolfr = nlayers
+
+! Upper atmosphere loop
+      do lay = laytrop+1, nlayers
+         if (jp(lay-1) .lt. layreffr .and. jp(lay) .ge. layreffr) &
+            laysolfr = lay
+         ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(29) + 1
+         ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(29) + 1
+         tauray = colmol(lay) * rayl
+
+         do ig = 1, ng29
+            taug(lay,ngs28+ig) = colco2(lay) * &
+                (fac00(lay) * absb(ind0,ig) + &
+                 fac10(lay) * absb(ind0+1,ig) + &
+                 fac01(lay) * absb(ind1,ig) + &
+                 fac11(lay) * absb(ind1+1,ig)) &  
+                 + colh2o(lay) * absh2o(ig) 
+!            ssa(lay,ngs28+ig) = tauray/taug(lay,ngs28+ig)
+            if (lay .eq. laysolfr) sfluxzen(ngs28+ig) = sfluxref(ig) 
+            taur(lay,ngs28+ig) = tauray
+         enddo
+      enddo
+
+      end subroutine taumol29
+
+      end subroutine taumol_sw
+
+      end module rrtmg_sw_taumol
+
Index: /palm/trunk/LIB/rrtmg/rrtmg_sw_vrtqdr.f90
===================================================================
--- /palm/trunk/LIB/rrtmg/rrtmg_sw_vrtqdr.f90	(revision 1585)
+++ /palm/trunk/LIB/rrtmg/rrtmg_sw_vrtqdr.f90	(revision 1585)
@@ -0,0 +1,154 @@
+!     path:      $Source$
+!     author:    $Author: mike $
+!     revision:  $Revision: 11661 $
+!     created:   $Date: 2009-05-22 18:22:22 -0400 (Fri, 22 May 2009) $
+!
+      module rrtmg_sw_vrtqdr
+
+!  --------------------------------------------------------------------------
+! |                                                                          |
+! |  Copyright 2002-2009, Atmospheric & Environmental Research, Inc. (AER).  |
+! |  This software may be used, copied, or redistributed as long as it is    |
+! |  not sold and this copyright notice is reproduced on each copy made.     |
+! |  This model is provided as is without any express or implied warranties. |
+! |                       (http://www.rtweb.aer.com/)                        |
+! |                                                                          |
+!  --------------------------------------------------------------------------
+
+! ------- Modules -------
+
+      use parkind, only: im => kind_im, rb => kind_rb
+!      use parrrsw, only: ngptsw
+
+      implicit none
+
+      contains
+
+! --------------------------------------------------------------------------
+      subroutine vrtqdr_sw(klev, kw, &
+                           pref, prefd, ptra, ptrad, &
+                           pdbt, prdnd, prup, prupd, ptdbt, &
+                           pfd, pfu)
+! --------------------------------------------------------------------------
+ 
+! 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(kind=im), intent (in) :: klev                   ! number of model layers
+      integer(kind=im), intent (in) :: kw                     ! g-point index
+
+      real(kind=rb), intent(in) :: pref(:)                    ! direct beam reflectivity
+                                                              !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(in) :: prefd(:)                   ! diffuse beam reflectivity
+                                                              !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(in) :: ptra(:)                    ! direct beam transmissivity
+                                                              !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(in) :: ptrad(:)                   ! diffuse beam transmissivity
+                                                              !   Dimensions: (nlayers+1)
+
+      real(kind=rb), intent(in) :: pdbt(:)
+                                                              !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(in) :: ptdbt(:)
+                                                              !   Dimensions: (nlayers+1)
+
+      real(kind=rb), intent(inout) :: prdnd(:)
+                                                              !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(inout) :: prup(:)
+                                                              !   Dimensions: (nlayers+1)
+      real(kind=rb), intent(inout) :: prupd(:)
+                                                              !   Dimensions: (nlayers+1)
+
+! Output
+      real(kind=rb), intent(out) :: pfd(:,:)                  ! downwelling flux (W/m2)
+                                                              !   Dimensions: (nlayers+1,ngptsw)
+                                                              ! unadjusted for earth/sun distance or zenith angle
+      real(kind=rb), intent(out) :: pfu(:,:)                  ! upwelling flux (W/m2)
+                                                              !   Dimensions: (nlayers+1,ngptsw)
+                                                              ! unadjusted for earth/sun distance or zenith angle
+
+! Local
+
+      integer(kind=im) :: ikp, ikx, jk
+
+      real(kind=rb) :: zreflect
+      real(kind=rb) :: ztdn(klev+1)  
+
+! 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
+             
+      zreflect = 1._rb / (1._rb - prefd(klev+1) * prefd(klev))
+      prup(klev) = pref(klev) + (ptrad(klev) * &
+                 ((ptra(klev) - pdbt(klev)) * prefd(klev+1) + &
+                   pdbt(klev) * pref(klev+1))) * zreflect
+      prupd(klev) = prefd(klev) + ptrad(klev) * ptrad(klev) * &
+                    prefd(klev+1) * zreflect
+
+! Pass from bottom to top 
+
+      do jk = 1,klev-1
+         ikp = klev+1-jk                       
+         ikx = ikp-1
+         zreflect = 1._rb / (1._rb -prupd(ikp) * prefd(ikx))
+         prup(ikx) = pref(ikx) + (ptrad(ikx) * &
+                   ((ptra(ikx) - pdbt(ikx)) * prupd(ikp) + &
+                     pdbt(ikx) * prup(ikp))) * zreflect
+         prupd(ikx) = prefd(ikx) + ptrad(ikx) * ptrad(ikx) * &
+                      prupd(ikp) * zreflect
+      enddo
+    
+! Upper boundary conditions
+
+      ztdn(1) = 1._rb
+      prdnd(1) = 0._rb
+      ztdn(2) = ptra(1)
+      prdnd(2) = prefd(1)
+
+! Pass from top to bottom
+
+      do jk = 2,klev
+         ikp = jk+1
+         zreflect = 1._rb / (1._rb - prefd(jk) * prdnd(jk))
+         ztdn(ikp) = ptdbt(jk) * ptra(jk) + &
+                    (ptrad(jk) * ((ztdn(jk) - ptdbt(jk)) + &
+                     ptdbt(jk) * pref(jk) * prdnd(jk))) * zreflect
+         prdnd(ikp) = prefd(jk) + ptrad(jk) * ptrad(jk) * &
+                      prdnd(jk) * zreflect
+      enddo
+    
+! Up and down-welling fluxes at levels
+
+      do jk = 1,klev+1
+         zreflect = 1._rb / (1._rb - prdnd(jk) * prupd(jk))
+         pfu(jk,kw) = (ptdbt(jk) * prup(jk) + &
+                      (ztdn(jk) - ptdbt(jk)) * prupd(jk)) * zreflect
+         pfd(jk,kw) = ptdbt(jk) + (ztdn(jk) - ptdbt(jk)+ &
+                      ptdbt(jk) * prup(jk) * prdnd(jk)) * zreflect
+      enddo
+
+      end subroutine vrtqdr_sw
+
+      end module rrtmg_sw_vrtqdr
Index: /palm/trunk/SCRIPTS/.mrun.config.imuk_hlrnIII_rrtmg
===================================================================
--- /palm/trunk/SCRIPTS/.mrun.config.imuk_hlrnIII_rrtmg	(revision 1585)
+++ /palm/trunk/SCRIPTS/.mrun.config.imuk_hlrnIII_rrtmg	(revision 1585)
@@ -0,0 +1,223 @@
+#$Id$
+#column 1          column 2                                   column 3
+#name of variable  value of variable (~ must not be used)     scope
+#----------------------------------------------------------------------------
+%mainprog          palm.f90
+%base_directory    $HOME/palm/current_version
+%base_data         ~/palm/current_version/JOBS
+%source_path       $base_directory/trunk/SOURCE
+%add_source_path   $base_directory/USER_CODE/$fname
+%depository_path   $base_directory/MAKE_DEPOSITORY
+#%use_makefile      true
+#
+# Enter your own host below by adding another line containing in the second
+# column your hostname (as provided by the unix command "hostname") and in the
+# third column the host identifier. Depending on your operating system, the
+# first characters of the host identifier should be "lc" (Linux cluster), "ibm"
+# (IBM-AIX), or "nec" (NEC-SX), respectively.
+#
+#
+# The next line is just an example. Add your own line below or replace this line.
+%host_identifier   <replace_by_your_IMUK_hostname>         lcmuk
+%host_identifier   hlogin*      lccrayh
+%host_identifier   hxc*         lccrayh
+%host_identifier   blogin*      lccrayb
+%host_identifier   bxc*         lccrayb
+#
+# IMUK 
+%remote_username   <replace_by_your_IMUK_username>                             lcmuk parallel rrtmg
+%tmp_user_catalog  /localdata                                                  lcmuk parallel rrtmg
+%compiler_name     mpif90                                                      lcmuk parallel rrtmg
+%compiler_name_ser ifort                                                       lcmuk parallel rrtmg
+%cpp_options       -cpp:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__fftw:-D__intel_compiler:-D__rrtmg  lcmuk parallel rrtmg
+%netcdf_inc        -I:/muksoft/packages/netcdf/4_intel/include                 lcmuk parallel rrtmg
+%netcdf_lib        -L/muksoft/packages/netcdf/4_intel/lib:-lnetcdf:-lnetcdff   lcmuk parallel rrtmg
+%fftw_inc          -I:/muksoft/packages/fftw/3.3.4/include                     lcmuk parallel rrtmg
+%fftw_lib          -L/muksoft/packages/fftw/3.3.4/lib64:-lfftw3                lcmuk parallel rrtmg
+%mopts             -j:4                                                        lcmuk parallel rrtmg
+%fopts             -fpe0:-O3:-cpp:-fp-model:source:-ftz:-fno-alias:-no-prec-div:-no-prec-sqrt:-ip:-nbs:-diag-disable:8290,8291:-I:/home/<replace_by_your_IMUK_username>/rrtmg/shared/include  lcmuk parallel rrtmg
+%lopts             -fpe0:-O3:-cpp:-fp-model:source:-ftz:-fno-alias:-no-prec-div:-no-prec-sqrt:-ip:-nbs:-diag-disable:8290,8291  lcmuk parallel rrtmg
+#
+# IMUK debug/trace mode
+%remote_username   <replace_by_your_IMUK_username>                             lcmuk parallel trace_rrtmg
+%tmp_user_catalog  /localdata                                                  lcmuk parallel trace_rrtmg
+%compiler_name     mpif90                                                      lcmuk parallel trace_rrtmg
+%compiler_name_ser ifort                                                       lcmuk parallel trace_rrtmg
+%cpp_options       -cpp:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__fftw:-D__intel_compiler:-D__rrtmg   lcmuk parallel trace_rrtmg
+%netcdf_inc        -I:/muksoft/packages/netcdf/4_intel/include                 lcmuk parallel trace_rrtmg
+%netcdf_lib        -L/muksoft/packages/netcdf/4_intel/lib:-lnetcdf:-lnetcdff   lcmuk parallel trace_rrtmg
+%fftw_inc          -I:/muksoft/packages/fftw/3.3.4/include                     lcmuk parallel trace_rrtmg
+%fftw_lib          -L/muksoft/packages/fftw/3.3.4/lib64:-lfftw3                lcmuk parallel trace_rrtmg
+%fopts             -fpe0:-C:-check:nooutput_conversion:-debug:-traceback:-g:-w:-xT:-O0:-ftz:-fno-alias:-no-prec-div:-no-prec-sqrt:-ip:-nbs:-convert:little_endian:-diag-disable:8290,8291:-I:/home/<replace_by_your_IMUK_username>/rrtmg/static_trace/include  lcmuk parallel trace_rrtmg
+%lopts             -fpe0:-C:-check:nooutput_conversion:-debug:-traceback:-g:-w:-xT:-O0:-ftz:-fno-alias:-no-prec-div:-no-prec-sqrt:-ip:-nbs:-limf:-lm:-Vaxlib       lcmuk parallel trace_rrtmg
+#
+# HLRN-III Hannover
+%tmp_user_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayh parallel rrtmg
+%tmp_data_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayh parallel rrtmg
+%compiler_name       ftn                                                lccrayh parallel rrtmg
+%compiler_name_ser   ftn                                                lccrayh parallel rrtmg
+%cpp_options         -e:Z:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__netcdf4:-D__netcdf4_parallel:-D__fftw:-D__rrtmg   lccrayh parallel rrtmg
+%mopts               -j:4                                               lccrayh parallel rrtmg
+%fopts               -em:-O3:-hnoomp:-hfp3:-hdynamic:-I:/home/h/<replace_by_your_HLRN_username>/rrtmg/shared/include   lccrayh parallel rrtmg
+%lopts               -em:-O3:-hnoomp:-hfp3:-hdynamic:-dynamic           lccrayh parallel rrtmg
+%remote_username     <replace_by_your_HLRN-III_username>                lccrayh parallel rrtmg
+%memory              2300                                               lccrayh parallel rrtmg
+%modules             fftw:cray-hdf5-parallel:cray-netcdf-hdf5parallel   lccrayh parallel rrtmg
+#
+# HLRN-III Hannover debug/trace mode
+%tmp_user_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayh parallel trace_rrtmg
+%tmp_data_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayh parallel trace_rrtmg
+%compiler_name       ftn                                                lccrayh parallel trace_rrtmg
+%compiler_name_ser   ftn                                                lccrayh parallel trace_rrtmg
+%cpp_options         -e:Z:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__netcdf4:-D__netcdf4_parallel:-D__fftw:-D__rrtmg   lccrayh parallel trace_rrtmg
+%mopts               -j:4                                               lccrayh parallel trace_rrtmg
+%fopts               -eD:-em:-g:-R:b:-K:trap=fp:-O0:-hnoomp:-I:/home/h/<replace_by_your_HLRN_username>/rrtmg/static_trace/include  lccrayh parallel trace_rrtmg
+%lopts               -eD:-em:-g:-R:b:-K:trap=fp:-O0:-hnoomp             lccrayh parallel trace_rrtmg
+%remote_username     <replace_by_your_HLRN-III_username>                lccrayh parallel trace_rrtmg
+%memory              2300                                               lccrayh parallel trace_rrtmg
+%modules             fftw:cray-hdf5-parallel:cray-netcdf-hdf5parallel   lccrayh parallel trace_rrtmg
+#
+# HLRN-III Berlin
+%tmp_user_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayb parallel rrtmg
+%tmp_data_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayb parallel rrtmg
+%compiler_name       ftn                                                lccrayb parallel rrtmg
+%compiler_name_ser   ftn                                                lccrayb parallel rrtmg
+%cpp_options         -e:Z:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__netcdf4:-D__netcdf4_parallel:-D__fftw:-D__rrtmg   lccrayb parallel rrtmg
+%mopts               -j:4                                               lccrayb parallel rrtmg
+%fopts               -em:-O3:-hnoomp:-hfp3:-hdynamic:-I:/home/b/<replace_by_your_HLRN_username>/rrtmg/shared/include  lccrayb parallel rrtmg
+%lopts               -em:-O3:-hnoomp:-hfp3:-hdynamic:-dynamic           lccrayb parallel rrtmg
+%remote_username     <replace_by_your_HLRN-III_username>                lccrayb parallel rrtmg
+%memory              2300                                               lccrayb parallel rrtmg
+%modules             fftw:cray-hdf5-parallel:cray-netcdf-hdf5parallel   lccrayb parallel rrtmg
+#
+# HLRN-III Berlin debug/trace mode
+%tmp_user_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayb parallel trace_rrtmg
+%tmp_data_catalog    /gfs2/work/<replace_by_your_HLRN-III_username>     lccrayb parallel trace_rrtmg
+%compiler_name       ftn                                                lccrayb parallel trace_rrtmg
+%compiler_name_ser   ftn                                                lccrayb parallel trace_rrtmg
+%cpp_options         -e:Z:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__netcdf4:-D__netcdf4_parallel:-D__fftw:-D__rrtmg   lccrayb parallel trace_rrtmg
+%mopts               -j:4                                               lccrayb parallel trace_rrtmg
+%fopts               -eD:-em:-g:-R:b:-K:trap=fp:-O0:-hnoomp:-I:/home/b/<replace_by_your_HLRN_username>/rrtmg/static_trace/include   lccrayb parallel trace_rrtmg
+%lopts               -eD:-em:-g:-R:b:-K:trap=fp:-O0:-hnoomp             lccrayb parallel trace_rrtmg
+%remote_username     <replace_by_your_HLRN-III_username>                lccrayb parallel trace_rrtmg
+%memory              2300                                               lccrayb parallel trace_rrtmg
+%modules             fftw:cray-hdf5-parallel:cray-netcdf-hdf5parallel   lccrayb parallel trace_rrtmg
+#
+%write_binary                true                             restart
+#
+#----------------------------------------------------------------------------
+# INPUT-commands, executed before running PALM - lines must start with "IC:"
+#----------------------------------------------------------------------------
+#IC:
+#
+#----------------------------------------------------------------------------
+# ERROR-commands - executed when program terminates abnormally
+#----------------------------------------------------------------------------
+EC:[[ \$locat = execution ]]  &&  cat  RUN_CONTROL
+EC:pwd; ls -al
+#
+#----------------------------------------------------------------------------
+# OUTPUT-commands - executed when program terminates normally
+#----------------------------------------------------------------------------
+# Combine all particle information files
+OC:[[ -f PARTICLE_INFOS/_0000 ]]  &&  cat  PARTICLE_INFOS/* >> PARTICLE_INFO
+#
+#----------------------------------------------------------------------------
+# List of input-files
+#----------------------------------------------------------------------------
+PARIN                    in:job        d3#      $base_data/$fname/INPUT    _p3d
+PARIN                    in:job        d3f      $base_data/$fname/INPUT    _p3df
+rrtmg_lw.nc              in:locopt     d3#:d3f  $base_data/$fname/INPUT    _rlw nc
+rrtmg_sw.nc              in:locopt     d3#:d3f  $base_data/$fname/INPUT    _rsw nc
+RAD_SND_DATA             in:locopt     d3#:d3f  $base_data/$fname/INPUT    _rsnd nc
+TOPOGRAPHY_DATA          in:locopt     d3#:d3f  $base_data/$fname/INPUT    _topo
+NUDGING_DATA             in:locopt     d3#:d3f  $base_data/$fname/INPUT    _nudge
+LSF_DATA                 in:locopt     d3#:d3f  $base_data/$fname/INPUT    _lsf
+BININ                    in:loc:flpe   d3f      $base_data/$fname/RESTART  _d3d
+PARTICLE_RESTART_DATA_IN in:loc:flpe   prtf     $base_data/$fname/RESTART  _rprt
+DATA_1D_PR_NETCDF        in:locopt     prf      $base_data/$fname/OUTPUT   _pr     nc
+DATA_1D_SP_NETCDF        in:locopt     spf      $base_data/$fname/OUTPUT   _sp     nc
+DATA_1D_TS_NETCDF        in:locopt     tsf      $base_data/$fname/OUTPUT   _ts     nc
+DATA_1D_PTS_NETCDF       in:locopt     ptsf     $base_data/$fname/OUTPUT   _pts    nc
+DATA_2D_XY_NETCDF        in:locopt     xyf      $base_data/$fname/OUTPUT   _xy     nc
+DATA_2D_XY_AV_NETCDF     in:locopt     xyf      $base_data/$fname/OUTPUT   _xy_av  nc
+DATA_2D_XZ_NETCDF        in:locopt     xzf      $base_data/$fname/OUTPUT   _xz     nc
+DATA_2D_YZ_NETCDF        in:locopt     yzf      $base_data/$fname/OUTPUT   _yz     nc
+DATA_3D_NETCDF           in:locopt     3df      $base_data/$fname/OUTPUT   _3d     nc
+DATA_PRT_NETCDF          in:locopt:pe  prtf     $base_data/$fname/OUTPUT   _prt
+#
+#----------------------------------------------------------------------------
+# List of output-files
+#----------------------------------------------------------------------------
+BINOUT                    out:loc:flpe restart   $base_data/$fname/RESTART  _d3d
+PARTICLE_RESTART_DATA_OUT out:loc:flpe prt#:prtf $base_data/$fname/RESTART  _rprt
+#
+RUN_CONTROL       out:loc:tr   d3#     $base_data/$fname/MONITORING  _rc
+RUN_CONTROL       out:loc:tra  d3f     $base_data/$fname/MONITORING  _rc
+HEADER            out:loc:tr   d3#     $base_data/$fname/MONITORING  _header
+HEADER            out:loc:tra  d3f     $base_data/$fname/MONITORING  _header
+CPU_MEASURES      out:loc:tr   d3#     $base_data/$fname/MONITORING  _cpu
+CPU_MEASURES      out:loc:tra  d3f     $base_data/$fname/MONITORING  _cpu
+#
+DATA_1D_PR_NETCDF    out:loc:tr   pr#:prf   $base_data/$fname/OUTPUT  _pr      nc
+DATA_1D_SP_NETCDF    out:loc:tr   sp#:spf   $base_data/$fname/OUTPUT  _sp      nc
+DATA_1D_TS_NETCDF    out:loc:tr   ts#:tsf   $base_data/$fname/OUTPUT  _ts      nc
+DATA_1D_PTS_NETCDF   out:loc:tr   pts#:ptsf $base_data/$fname/OUTPUT  _pts     nc
+DATA_2D_XY_NETCDF    out:loc:tr   xy#:xyf   $base_data/$fname/OUTPUT  _xy      nc
+DATA_2D_XY_AV_NETCDF out:loc:tr   xy#:xyf   $base_data/$fname/OUTPUT  _xy_av   nc
+DATA_2D_XZ_NETCDF    out:loc:tr   xz#:xzf   $base_data/$fname/OUTPUT  _xz      nc
+DATA_2D_XZ_AV_NETCDF out:loc:tr   xz#:xzf   $base_data/$fname/OUTPUT  _xz_av   nc
+DATA_2D_YZ_NETCDF    out:loc:tr   yz#:yzf   $base_data/$fname/OUTPUT  _yz      nc
+DATA_2D_YZ_AV_NETCDF out:loc:tr   yz#:yzf   $base_data/$fname/OUTPUT  _yz_av   nc
+DATA_3D_NETCDF       out:loc:tr   3d#:3df   $base_data/$fname/OUTPUT  _3d      nc
+DATA_3D_AV_NETCDF    out:loc:tr   3d#:3df   $base_data/$fname/OUTPUT  _3d_av   nc
+DATA_MASK_01_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m01     nc
+DATA_MASK_01_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m01_av  nc
+DATA_MASK_02_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m02     nc
+DATA_MASK_02_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m02_av  nc
+DATA_MASK_03_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m03     nc
+DATA_MASK_03_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m03_av  nc
+DATA_MASK_04_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m04     nc
+DATA_MASK_04_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m04_av  nc
+DATA_MASK_05_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m05     nc
+DATA_MASK_05_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m05_av  nc
+DATA_MASK_06_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m06     nc
+DATA_MASK_06_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m06_av  nc
+DATA_MASK_07_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m07     nc
+DATA_MASK_07_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m07_av  nc
+DATA_MASK_08_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m08     nc
+DATA_MASK_08_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m08_av  nc
+DATA_MASK_09_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m09     nc
+DATA_MASK_09_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m09_av  nc
+DATA_MASK_10_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m10     nc
+DATA_MASK_10_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m10_av  nc
+DATA_MASK_11_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m11     nc
+DATA_MASK_11_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m11_av  nc
+DATA_MASK_12_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m12     nc
+DATA_MASK_12_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m12_av  nc
+DATA_MASK_13_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m13     nc
+DATA_MASK_13_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m13_av  nc
+DATA_MASK_14_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m14     nc
+DATA_MASK_14_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m14_av  nc
+DATA_MASK_15_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m15     nc
+DATA_MASK_15_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m15_av  nc
+DATA_MASK_16_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m16     nc
+DATA_MASK_16_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m16_av  nc
+DATA_MASK_17_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m17     nc
+DATA_MASK_17_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m17_av  nc
+DATA_MASK_18_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m18     nc
+DATA_MASK_18_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m18_av  nc
+DATA_MASK_19_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m19     nc
+DATA_MASK_19_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m19_av  nc
+DATA_MASK_20_NETCDF    out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m20     nc
+DATA_MASK_20_AV_NETCDF out:loc:tr ma#:maf   $base_data/$fname/OUTPUT  _m20_av  nc
+DATA_PRT_NETCDF      out:loc:pe   prt#:prtf $base_data/$fname/OUTPUT  _prt     nc
+DATA_PRT_NETCDF      out:loc:trpe prt#:prtf $base_data/$fname/OUTPUT  _prt     nc
+DATA_DVR             out:loc:trpe dvr       $base_data/$fname/OUTPUT  _dvr
+#
+DVRP_LOG          out:loc:tr   dv#       $base_data/$fname/MONITORING  _dvrp_log
+DVRP_LOG          out:loc:tra  dvf       $base_data/$fname/MONITORING  _dvrp_log
+PARTICLE_INFO     out:loc:tr   pt#       $base_data/$fname/MONITORING  _prt_info
+PARTICLE_INFO     out:loc:tra  ptf       $base_data/$fname/MONITORING  _prt_info
+PARTICLE_DATA     out:loc:flpe prt#:prtf $base_data/$fname/OUTPUT      _prt_dat
+# A BLANK LINE MUST FOLLOW
Index: /palm/trunk/SOURCE/Makefile
===================================================================
--- /palm/trunk/SOURCE/Makefile	(revision 1584)
+++ /palm/trunk/SOURCE/Makefile	(revision 1585)
@@ -20,5 +20,5 @@
 # Current revisions:
 # ------------------
-# 
+# Added user_init_radiation.f90
 # 
 # Former revisions:
@@ -223,5 +223,5 @@
 	init_pegrid.f90 init_pt_anomaly.f90 init_rankine.f90 init_slope.f90 \
 	interaction_droplets_ptq.f90 land_surface_model.f90 local_flush.f90 \
-   local_getenv.f90 local_stop.f90 local_system.f90 local_tremain.f90 \
+	local_getenv.f90 local_stop.f90 local_system.f90 local_tremain.f90 \
 	local_tremain_ini.f90 lpm.f90 lpm_advec.f90 lpm_boundary_conds.f90 \
 	lpm_calc_liquid_water_content.f90 lpm_collision_kernels.f90 \
@@ -253,9 +253,11 @@
 	user_dvrp_coltab.f90 user_header.f90 user_init.f90 \
 	user_init_3d_model.f90 user_init_grid.f90 user_init_land_surface.f90 \
-	user_init_plant_canopy.f90 user_last_actions.f90 user_lpm_advec.f90 \
+	user_init_plant_canopy.f90 user_init_radiation.f90 \
+	user_last_actions.f90 user_lpm_advec.f90 \
 	user_lpm_init.f90 user_lpm_set_attributes.f90 user_module.f90 \
 	user_parin.f90 user_read_restart_data.f90 \
 	user_spectra.f90 user_statistics.f90 wall_fluxes.f90 \
 	write_3d_binary.f90 write_var_list.f90
+
 
 OBJS=$(SOURCES:.f90=.o)
@@ -427,5 +429,5 @@
 	nudging.o plant_canopy_model.o production_e.o subsidence.o user_actions.o
 progress_bar.o: modules.o mod_kinds.o
-radiation_model.o : modules.o
+radiation_model.o : modules.o mod_particle_attributes.o
 random_function.o: mod_kinds.o
 random_gauss.o: mod_kinds.o random_function.o random_generator_parallel.o
@@ -473,4 +475,5 @@
 user_init_land_surface.o: modules.o mod_kinds.o user_module.o land_surface_model.o
 user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model.o
+user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model.o
 user_last_actions.o: modules.o mod_kinds.o user_module.o
 user_lpm_advec.o: modules.o mod_kinds.o user_module.o
Index: /palm/trunk/SOURCE/average_3d_data.f90
===================================================================
--- /palm/trunk/SOURCE/average_3d_data.f90	(revision 1584)
+++ /palm/trunk/SOURCE/average_3d_data.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Adapted for RRTMG
 ! 
 ! Former revisions:
@@ -88,5 +88,7 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av
+        ONLY:  rad_net, rad_net_av, rad_lw_in, rad_lw_in_av, rad_lw_out,       &
+               rad_lw_out_av, rad_sw_in, rad_sw_in_av, rad_sw_out,             &
+               rad_sw_out_av
 
     IMPLICIT NONE
@@ -349,15 +351,44 @@
              ENDDO
 
-         CASE ( 'rad_sw_in*' )
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   rad_sw_in_av(j,i) = rad_sw_in_av(j,i) / REAL( average_count_3d, KIND=wp )
-                ENDDO
-             ENDDO
-
          CASE ( 'rad_net*' )
              DO  i = nxlg, nxrg
                 DO  j = nysg, nyng
                    rad_net_av(j,i) = rad_net_av(j,i) / REAL( average_count_3d, KIND=wp )
+                ENDDO
+             ENDDO
+
+          CASE ( 'rad_lw_in' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) / REAL( average_count_3d, KIND=wp )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'rad_lw_out' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) / REAL( average_count_3d, KIND=wp )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'rad_sw_in' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) / REAL( average_count_3d, KIND=wp )
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'rad_sw_out' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) / REAL( average_count_3d, KIND=wp )
+                   ENDDO
                 ENDDO
              ENDDO
Index: /palm/trunk/SOURCE/check_parameters.f90
===================================================================
--- /palm/trunk/SOURCE/check_parameters.f90	(revision 1584)
+++ /palm/trunk/SOURCE/check_parameters.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Added support for RRTMG
 !
 ! Former revisions:
@@ -1143,14 +1143,24 @@
 
     IF ( radiation )  THEN
-       IF ( radiation_scheme == 'constant' )  THEN
-          irad_scheme = 0
-       ELSEIF ( radiation_scheme == 'clear-sky' )  THEN
-          irad_scheme = 1
-       ELSEIF ( radiation_scheme == 'rrtm' )  THEN
-          irad_scheme = 2
-       ELSE
+       IF ( radiation_scheme /= 'constant'  .AND.                              &
+            radiation_scheme /= 'clear-sky' .AND.                              &
+            radiation_scheme /= 'rrtmg' )  THEN
           message_string = 'unknown radiation_scheme = '//                     &
                            TRIM( radiation_scheme )
           CALL message( 'check_parameters', 'PA0405', 1, 2, 0, 6, 0 )
+       ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
+#if ! defined ( __rrtmg )
+          message_string = 'radiation_scheme = "rrtmg" requires ' //           & 
+                           'compilation of PALM with pre-processor ' //        &
+                           'directive -D__rrtmg'
+          CALL message( 'check_parameters', 'PA0407', 1, 2, 0, 6, 0 )
+#endif
+       ENDIF
+       IF ( albedo_type == 0 .AND. albedo == 9999999.9_wp .AND.                &
+            radiation_scheme == 'clear-sky')  THEN
+          message_string = 'radiation_scheme = "clear-sky" in combination' //  & 
+                           'with albedo_type = 0 requires setting of albedo'// &
+                           ' /= 9999999.9'
+          CALL message( 'check_parameters', 'PA0410', 1, 2, 0, 6, 0 )
        ENDIF
     ENDIF
@@ -3058,4 +3068,55 @@
              ENDIF
 
+          CASE ( 'rad_lw_in' )
+             IF ( (.NOT. radiation) .OR. radiation_scheme == 'constant' )  THEN
+                message_string = 'data_output_pr = ' //                        &
+                                 TRIM( data_output_pr(i) ) // ' is not ava' // &
+                                 'lable for radiation = .FALSE. or ' //        &
+                                 'radiation_scheme = "constant"'
+                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
+             ELSE
+                dopr_index(i) = 102
+                dopr_unit(i)  = 'W/m2'
+                hom(:,2,102,:)  = SPREAD( zw, 2, statistic_regions+1 )
+             ENDIF
+
+          CASE ( 'rad_lw_out' )
+             IF ( (.NOT. radiation) .OR. radiation_scheme == 'constant' )  THEN
+                message_string = 'data_output_pr = ' //                        &
+                                 TRIM( data_output_pr(i) ) // ' is not ava' // &
+                                 'lable for radiation = .FALSE. or ' //        &
+                                 'radiation_scheme = "constant"'
+                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
+             ELSE
+                dopr_index(i) = 103
+                dopr_unit(i)  = 'W/m2'
+                hom(:,2,103,:)  = SPREAD( zw, 2, statistic_regions+1 )
+             ENDIF
+
+          CASE ( 'rad_sw_in' )
+             IF ( (.NOT. radiation) .OR. radiation_scheme == 'constant' )  THEN
+                message_string = 'data_output_pr = ' //                        &
+                                 TRIM( data_output_pr(i) ) // ' is not ava' // &
+                                 'lable for radiation = .FALSE. or ' //        &
+                                 'radiation_scheme = "constant"'
+                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
+             ELSE
+                dopr_index(i) = 104
+                dopr_unit(i)  = 'W/m2'
+                hom(:,2,104,:)  = SPREAD( zw, 2, statistic_regions+1 )
+             ENDIF
+
+          CASE ( 'rad_sw_out')
+             IF ( (.NOT. radiation) .OR. radiation_scheme == 'constant' )  THEN
+                message_string = 'data_output_pr = ' //                        &
+                                 TRIM( data_output_pr(i) ) // ' is not ava' // &
+                                 'lable for radiation = .FALSE. or ' //        &
+                                 'radiation_scheme = "constant"'
+                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
+             ELSE
+                dopr_index(i) = 105
+                dopr_unit(i)  = 'W/m2'
+                hom(:,2,105,:)  = SPREAD( zw, 2, statistic_regions+1 )
+             ENDIF
 
           CASE DEFAULT
@@ -3257,4 +3318,14 @@
              unit = 'kg/kg'
 
+
+          CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_sw_in', 'rad_sw_out' )
+             IF ( .NOT. radiation .OR. radiation_scheme /= 'rrtmg' )  THEN
+                message_string = '"output of "' // TRIM( var ) // '" requi' //  &
+                                 'res radiation = .TRUE. and ' //              &
+                                 'radiation_scheme = "rrtmg"'
+                CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
+             ENDIF
+             unit = 'W/m2'
+
           CASE ( 'rho' )
              IF ( .NOT. ocean )  THEN
@@ -3293,6 +3364,6 @@
                  'm_liq_eb*', 'pra*', 'prr*', 'qsws*', 'qsws_eb*',             &
                  'qsws_liq_eb*', 'qsws_soil_eb*', 'qsws_veg_eb*', 'rad_net*',  &
-                 'rad_sw_in*', 'r_a*', 'r_s*', 'shf*', 'shf_eb*', 't*',        &
-                 'u*', 'z0*', 'z0h*' )
+                 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', 'rrtm_asdir*',   &
+                 'r_a*', 'r_s*', 'shf*', 'shf_eb*', 't*', 'u*', 'z0*', 'z0h*' )
              IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
                 message_string = 'illegal value for data_output: "' //         &
@@ -3301,4 +3372,17 @@
                 CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
              ENDIF
+             IF ( .NOT. radiation .OR. radiation_scheme /= "rrtmg" )  THEN
+                IF ( TRIM( var ) == 'rrtm_aldif*' .OR.                         &
+                     TRIM( var ) == 'rrtm_aldir*' .OR.                         &
+                     TRIM( var ) == 'rrtm_asdif*' .OR.                         &
+                     TRIM( var ) == 'rrtm_asdir*'      )                       &
+                THEN
+                   message_string = 'output of "' // TRIM( var ) // '" require'&
+                                    // 's radiation = .TRUE. and radiation_sch'&
+                                    // 'eme = "rrtmg"'
+                   CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 )
+                ENDIF
+             ENDIF
+
              IF ( TRIM( var ) == 'c_liq*'  .AND.  .NOT. land_surface )  THEN
                 message_string = 'output of "' // TRIM( var ) // '" requi' //  &
@@ -3405,6 +3489,9 @@
              IF ( TRIM( var ) == 'qsws_soil_eb*' ) unit = 'W/m2'
              IF ( TRIM( var ) == 'qsws_veg_eb*'  ) unit = 'W/m2'
-             IF ( TRIM( var ) == 'rad_net*')       unit = 'W/m2'     
-             IF ( TRIM( var ) == 'rad_sw_in*')     unit = 'W/m2' 
+             IF ( TRIM( var ) == 'rad_net*'      ) unit = 'W/m2'   
+             IF ( TRIM( var ) == 'rrtm_aldif*'   ) unit = ''   
+             IF ( TRIM( var ) == 'rrtm_aldir*'   ) unit = '' 
+             IF ( TRIM( var ) == 'rrtm_asdif*'   ) unit = '' 
+             IF ( TRIM( var ) == 'rrtm_asdir*'   ) unit = '' 
              IF ( TRIM( var ) == 'r_a*')     unit = 's/m'     
              IF ( TRIM( var ) == 'r_s*')     unit = 's/m' 
Index: /palm/trunk/SOURCE/data_output_2d.f90
===================================================================
--- /palm/trunk/SOURCE/data_output_2d.f90	(revision 1584)
+++ /palm/trunk/SOURCE/data_output_2d.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Added support for RRTMG
 ! 
 ! Former revisions:
@@ -154,5 +154,7 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av
+        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av, rad_sw_out,       &
+               rad_sw_out_av, rad_lw_in, rad_lw_in_av, rad_lw_out,             &
+               rad_lw_out_av 
 
     IMPLICIT NONE
@@ -913,21 +915,32 @@
                 level_z(nzb+1) = zu(nzb+1)
 
-             CASE ( 'rad_sw_in*_xy' )        ! 2d-array
-                IF ( av == 0 ) THEN
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng
-                         local_pf(i,j,nzb+1) =  rad_sw_in(j,i)
-                      ENDDO
-                   ENDDO
-                ELSE
-                   DO  i = nxlg, nxrg
-                      DO  j = nysg, nyng 
-                         local_pf(i,j,nzb+1) =  rad_sw_in_av(j,i)
-                      ENDDO
-                   ENDDO
-                ENDIF
-                resorted = .TRUE.
-                two_d = .TRUE.
-                level_z(nzb+1) = zu(nzb+1)
+
+             CASE ( 'rad_lw_in_xy', 'rad_lw_in_xz', 'rad_lw_in_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => rad_lw_in
+                ELSE
+                   to_be_resorted => rad_lw_in_av
+                ENDIF
+
+             CASE ( 'rad_lw_out_xy', 'rad_lw_out_xz', 'rad_lw_out_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => rad_lw_out
+                ELSE
+                   to_be_resorted => rad_lw_out_av
+                ENDIF
+
+             CASE ( 'rad_sw_in_xy', 'rad_sw_in_xz', 'rad_sw_in_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => rad_sw_in
+                ELSE
+                   to_be_resorted => rad_sw_in_av
+                ENDIF
+
+             CASE ( 'rad_sw_out_xy', 'rad_sw_out_xz', 'rad_sw_out_yz' )
+                IF ( av == 0 )  THEN
+                   to_be_resorted => rad_sw_out
+                ELSE
+                   to_be_resorted => rad_sw_out_av
+                ENDIF
 
              CASE ( 'rho_xy', 'rho_xz', 'rho_yz' )
Index: /palm/trunk/SOURCE/data_output_3d.f90
===================================================================
--- /palm/trunk/SOURCE/data_output_3d.f90	(revision 1584)
+++ /palm/trunk/SOURCE/data_output_3d.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Added support for RRTMG
 ! 
 ! Former revisions:
@@ -128,4 +128,9 @@
         
     USE pegrid
+
+    USE radiation_model_mod,                                                   &
+        ONLY:  rad_lw_in, rad_lw_in_av, rad_lw_out, rad_lw_out_av,             &
+               rad_sw_in, rad_sw_in_av, rad_sw_out, rad_sw_out_av
+
 
     IMPLICIT NONE
@@ -467,4 +472,32 @@
              ELSE
                 to_be_resorted => qv_av
+             ENDIF
+
+          CASE ( 'rad_sw_in' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_sw_in
+             ELSE
+                to_be_resorted => rad_sw_in_av
+             ENDIF
+
+          CASE ( 'rad_sw_out' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_sw_out
+             ELSE
+                to_be_resorted => rad_sw_out_av
+             ENDIF
+
+          CASE ( 'rad_lw_in' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_lw_in
+             ELSE
+                to_be_resorted => rad_lw_in_av
+             ENDIF
+
+          CASE ( 'rad_lw_out' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_lw_out
+             ELSE
+                to_be_resorted => rad_lw_out_av
              ENDIF
 
Index: /palm/trunk/SOURCE/data_output_mask.f90
===================================================================
--- /palm/trunk/SOURCE/data_output_mask.f90	(revision 1584)
+++ /palm/trunk/SOURCE/data_output_mask.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Added support for RRTMG
 ! 
 ! Former revisions:
@@ -108,4 +108,8 @@
     
     USE pegrid
+
+    USE radiation_model_mod,                                                   &
+        ONLY:  rad_lw_in, rad_lw_in_av, rad_lw_out, rad_lw_out_av,             &
+               rad_sw_in, rad_sw_in_av, rad_sw_out, rad_sw_out_av
 
     IMPLICIT NONE
@@ -393,4 +397,32 @@
              ENDIF
 
+          CASE ( 'rad_sw_in' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_sw_in
+             ELSE
+                to_be_resorted => rad_sw_in_av
+             ENDIF
+
+          CASE ( 'rad_sw_out' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_sw_out
+             ELSE
+                to_be_resorted => rad_sw_out_av
+             ENDIF
+
+          CASE ( 'rad_lw_in' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_lw_in
+             ELSE
+                to_be_resorted => rad_lw_in_av
+             ENDIF
+
+          CASE ( 'rad_lw_out' )
+             IF ( av == 0 )  THEN
+                to_be_resorted => rad_lw_out
+             ELSE
+                to_be_resorted => rad_lw_out_av
+             ENDIF
+
           CASE ( 'rho' )
              IF ( av == 0 )  THEN
Index: /palm/trunk/SOURCE/flow_statistics.f90
===================================================================
--- /palm/trunk/SOURCE/flow_statistics.f90	(revision 1584)
+++ /palm/trunk/SOURCE/flow_statistics.f90	(revision 1585)
@@ -21,5 +21,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Added output of timeseries and profiles for RRTMG
 ! 
 ! Former revisions:
@@ -178,6 +178,12 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY :  dots_rad, rad_net, rad_sw_in, radiation
-    
+        ONLY:  dots_rad, radiation, radiation_scheme, rad_net,                 &
+               rad_lw_in, rad_lw_out, rad_sw_in, rad_sw_out
+
+#if defined ( __rrtmg )
+    USE radiation_model_mod,                                                   &
+        ONLY:  rrtm_aldif, rrtm_aldir, rrtm_asdif, rrtm_asdir
+#endif
+  
     USE statistics
 
@@ -741,5 +747,18 @@
              IF ( radiation )  THEN
                 sums_l(nzb,101,tn)  = sums_l(nzb,101,tn)  + rad_net(j,i)
-                sums_l(nzb,102,tn) = sums_l(nzb,102,tn) + rad_sw_in(j,i)
+                sums_l(nzb,102,tn)  = sums_l(nzb,102,tn)  + rad_lw_in(nzb,j,i)
+                sums_l(nzb,103,tn)  = sums_l(nzb,103,tn)  + rad_lw_out(nzb,j,i)
+                sums_l(nzb,104,tn)  = sums_l(nzb,104,tn)  + rad_sw_in(nzb,j,i)
+                sums_l(nzb,105,tn)  = sums_l(nzb,105,tn)  + rad_sw_out(nzb,j,i)
+
+#if defined ( __rrtmg )
+                IF ( radiation_scheme == 'rrtmg' )  THEN
+                   sums_l(nzb,106,tn)  = sums_l(nzb,106,tn)  + rrtm_aldif(0,j,i)
+                   sums_l(nzb,107,tn)  = sums_l(nzb,107,tn)  + rrtm_aldir(0,j,i)
+                   sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  + rrtm_asdif(0,j,i)
+                   sums_l(nzb,109,tn)  = sums_l(nzb,109,tn)  + rrtm_asdir(0,j,i)
+                ENDIF
+#endif
+
              ENDIF
 
@@ -1126,5 +1145,17 @@
        ENDIF
        
-
+       IF ( radiation .AND. radiation_scheme == 'rrtmg' )  THEN
+          !$OMP DO
+          DO  i = nxl, nxr
+             DO  j =  nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt+1
+                   sums_l(k,102,tn)  = sums_l(k,102,tn)  + rad_lw_in(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,103,tn)  = sums_l(k,103,tn)  + rad_lw_out(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,104,tn)  = sums_l(k,104,tn)  + rad_sw_in(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,105,tn)  = sums_l(k,105,tn)  + rad_sw_out(k,j,i) * rmask(j,i,sr)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
 !
 !--    Calculate the user-defined profiles
@@ -1186,6 +1217,6 @@
           sums(k,70:80)           = sums(k,70:80)       / ngp_2dh_s_inner(k,sr)
           sums(k,81:88)           = sums(k,81:88)       / ngp_2dh(sr)
-          sums(k,89:100)           = sums(k,89:100)     / ngp_2dh(sr)
-          sums(k,101:pr_palm-2)    = sums(k,101:pr_palm-2)/ ngp_2dh_s_inner(k,sr)
+          sums(k,89:105)           = sums(k,89:105)     / ngp_2dh(sr)
+          sums(k,106:pr_palm-2)    = sums(k,106:pr_palm-2)/ ngp_2dh_s_inner(k,sr)
        ENDDO
 
@@ -1319,6 +1350,19 @@
 
        IF ( radiation )  THEN
-          hom(:,1,101 ,sr) = sums(:,101)            ! rad_net
-          hom(:,1,102,sr)  = sums(:,102)            ! rad_sw_in
+          hom(:,1,101,sr) = sums(:,101)            ! rad_net
+          hom(:,1,102,sr) = sums(:,102)            ! rad_lw_in
+          hom(:,1,103,sr) = sums(:,103)            ! rad_lw_out
+          hom(:,1,104,sr) = sums(:,104)            ! rad_sw_in
+          hom(:,1,105,sr) = sums(:,105)            ! rad_sw_out
+
+#if defined ( __rrtmg )
+          IF ( radiation_scheme == 'rrtmg' )  THEN
+             hom(:,1,106,sr) = sums(:,106)            ! rrtm_aldif
+             hom(:,1,107,sr) = sums(:,107)            ! rrtm_aldir
+             hom(:,1,108,sr) = sums(:,108)            ! rrtm_asdif
+             hom(:,1,109,sr) = sums(:,109)            ! rrtm_asdir
+          ENDIF
+#endif
+
        ENDIF
 
@@ -1483,6 +1527,19 @@
 !--    Collect radiation model timeseries
        IF ( radiation )  THEN
-          ts_value(dots_rad,sr)   = hom(nzb,1,101,sr)           ! rad_net
-          ts_value(dots_rad+1,sr) = hom(nzb,1,102,sr)          ! rad_sw_in
+          ts_value(dots_rad,sr)   = hom(nzb,1,101,sr)          ! rad_net
+          ts_value(dots_rad+1,sr) = hom(nzb,1,102,sr)          ! rad_lw_in
+          ts_value(dots_rad+2,sr) = hom(nzb,1,103,sr)          ! rad_lw_out
+          ts_value(dots_rad+3,sr) = hom(nzb,1,104,sr)          ! rad_lw_in
+          ts_value(dots_rad+4,sr) = hom(nzb,1,105,sr)          ! rad_lw_out
+
+#if defined ( __rrtmg )
+          IF ( radiation_scheme == 'rrtmg' )  THEN
+             ts_value(dots_rad+5,sr) = hom(nzb,1,106,sr)          ! rrtm_aldif
+             ts_value(dots_rad+6,sr) = hom(nzb,1,107,sr)          ! rrtm_aldir
+             ts_value(dots_rad+7,sr) = hom(nzb,1,108,sr)          ! rrtm_asdif
+             ts_value(dots_rad+8,sr) = hom(nzb,1,109,sr)          ! rrtm_asdir
+          ENDIF
+#endif
+
        ENDIF
 
@@ -2951,4 +3008,18 @@
 
 
+       IF ( radiation .AND. radiation_scheme == 'rrtmg' )  THEN
+          !$OMP DO
+          DO  i = nxl, nxr
+             DO  j =  nys, nyn
+                DO  k = nzb_s_inner(j,i)+1, nzt+1
+                   sums_l(k,102,tn)  = sums_l(k,102,tn)  + rad_lw_in(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,103,tn)  = sums_l(k,103,tn)  + rad_lw_out(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,104,tn)  = sums_l(k,104,tn)  + rad_sw_in(k,j,i) * rmask(j,i,sr)
+                   sums_l(k,105,tn)  = sums_l(k,105,tn)  + rad_sw_out(k,j,i) * rmask(j,i,sr)
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+
 !
 !--    Calculate the user-defined profiles
@@ -3012,6 +3083,6 @@
           sums(k,70:80)           = sums(k,70:80)       / ngp_2dh_s_inner(k,sr)
           sums(k,81:88)           = sums(k,81:88)       / ngp_2dh(sr)
-          sums(k,89:100)           = sums(k,89:100)     / ngp_2dh(sr)
-          sums(k,101:pr_palm-2)    = sums(k,101:pr_palm-2)/ ngp_2dh_s_inner(k,sr)
+          sums(k,89:105)           = sums(k,89:105)     / ngp_2dh(sr)
+          sums(k,106:pr_palm-2)    = sums(k,106:pr_palm-2)/ ngp_2dh_s_inner(k,sr)
        ENDDO
 
@@ -3288,6 +3359,19 @@
 !--    Collect radiation model timeseries
        IF ( radiation )  THEN
-          ts_value(dots_rad,sr)   = hom(nzb,1,101,sr)           ! rad_net
-          ts_value(dots_rad+1,sr) = hom(nzb,1,102,sr)          ! rad_sw_in
+          ts_value(dots_rad,sr)   = hom(nzb,1,101,sr)          ! rad_net
+          ts_value(dots_rad+1,sr) = hom(nzb,1,102,sr)          ! rad_lw_in
+          ts_value(dots_rad+2,sr) = hom(nzb,1,103,sr)          ! rad_lw_out
+          ts_value(dots_rad+3,sr) = hom(nzb,1,104,sr)          ! rad_lw_in
+          ts_value(dots_rad+4,sr) = hom(nzb,1,105,sr)          ! rad_lw_out
+
+#if defined ( __rrtmg )
+          IF ( radiation_scheme == 'rrtmg' )  THEN
+             ts_value(dots_rad+5,sr) = hom(nzb,1,106,sr)          ! rrtm_aldif
+             ts_value(dots_rad+6,sr) = hom(nzb,1,107,sr)          ! rrtm_aldir
+             ts_value(dots_rad+7,sr) = hom(nzb,1,108,sr)          ! rrtm_asdif
+             ts_value(dots_rad+8,sr) = hom(nzb,1,109,sr)          ! rrtm_asdir
+          ENDIF
+#endif
+
        ENDIF
 
Index: /palm/trunk/SOURCE/header.f90
===================================================================
--- /palm/trunk/SOURCE/header.f90	(revision 1584)
+++ /palm/trunk/SOURCE/header.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Further output for radiation model(s).
 !
 ! Former revisions:
@@ -245,6 +245,7 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  albedo, day_init, dt_radiation, lambda, net_radiation,          &
-               radiation, radiation_scheme, time_utc_init
+        ONLY:  albedo, albedo_type, albedo_type_name, constant_albedo,         &
+               day_init, dt_radiation, lambda, lw_radiation, net_radiation,    &
+               radiation, radiation_scheme, sw_radiation, time_utc_init
     
     USE spectrum,                                                              &
@@ -927,5 +928,5 @@
     IF ( radiation )  THEN
 !
-!--    Write land surface model header
+!--    Write radiation model header
        WRITE( io, 444 )
 
@@ -934,11 +935,19 @@
        ELSEIF ( radiation_scheme == "clear-sky" )  THEN
           WRITE( io, 446 )
-       ELSE
-          WRITE( io, 447 ) radiation_scheme
-       ENDIF
-
-       WRITE( io, 448 ) albedo
+       ELSEIF ( radiation_scheme == "rrtmg" )  THEN
+          WRITE( io, 447 )
+          IF ( .NOT. lw_radiation )  WRITE( io, 458 )
+          IF ( .NOT. sw_radiation )  WRITE( io, 459 )
+       ENDIF
+
+       IF ( albedo_type == 0 )  THEN
+          WRITE( io, 448 ) albedo
+       ELSE
+          WRITE( io, 456 ) albedo_type_name(albedo_type)
+       ENDIF
+       IF ( constant_albedo )  THEN
+          WRITE( io, 457 )
+       ENDIF
        WRITE( io, 449 ) dt_radiation
-
     ENDIF
 
@@ -2262,7 +2271,7 @@
 446 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,',  &
                    ' default)')
-447 FORMAT (' --> Radiation scheme:', A)
-448 FORMAT (/'    Surface albedo: albedo = ', F5.3)
-449 FORMAT  ('    Timestep: dt_radiation = ', F5.2, '  s')
+447 FORMAT (' --> RRTMG scheme is used')
+448 FORMAT (/'     User-specific surface albedo: albedo = ', F5.3)
+449 FORMAT  ('     Timestep: dt_radiation = ', F5.2, '  s')
 
 450 FORMAT (//' LES / Turbulence quantities:'/ &
@@ -2273,4 +2282,8 @@
 454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
 455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
+456 FORMAT (/'    Albedo is set for land surface type: ', A)
+457 FORMAT (/'    --> Albedo is fixed during the run')
+458 FORMAT (/'    --> Longwave radiation is disabled')
+459 FORMAT (/'    --> Shortwave radiation is disabled.')
 470 FORMAT (//' Actions during the simulation:'/ &
               ' -----------------------------'/)
Index: /palm/trunk/SOURCE/init_3d_model.f90
===================================================================
--- /palm/trunk/SOURCE/init_3d_model.f90	(revision 1584)
+++ /palm/trunk/SOURCE/init_3d_model.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Initialization of radiation code is now done after LSM initializtion
 !
 ! Former revisions:
@@ -1606,15 +1606,18 @@
     IF ( particle_advection )  CALL lpm_init
 
+!
+!-- If required, initialize quantities needed for the LSM
+    IF ( land_surface )  THEN
+       CALL location_message( 'initializing land surface model', .FALSE. )
+       CALL init_lsm
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
 
 !
 !-- If required, initialize radiation model
     IF ( radiation )  THEN
+       CALL location_message( 'initializing radiation model', .FALSE. )
        CALL init_radiation
-    ENDIF
-
-!
-!-- If required, initialize quantities needed for the LSM
-    IF ( land_surface )  THEN
-       CALL init_lsm
+       CALL location_message( 'finished', .TRUE. )
     ENDIF
 
Index: /palm/trunk/SOURCE/land_surface_model.f90
===================================================================
--- /palm/trunk/SOURCE/land_surface_model.f90	(revision 1584)
+++ /palm/trunk/SOURCE/land_surface_model.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Modifications for RRTMG. Changed tables to PARAMETER type. 
 ! 
 ! Former revisions:
@@ -80,5 +80,5 @@
 !------------------------------------------------------------------------------!
      USE arrays_3d,                                                            &
-         ONLY:  pt, pt_p, q, q_p, qsws, rif, shf, ts, us, z0, z0h
+         ONLY:  pt, pt_p, q_p, qsws, rif, shf, ts, us, z0, z0h
 
      USE cloud_parameters,                                                     &
@@ -90,8 +90,8 @@
                 max_masks, precipitation, pt_surface, rho_surface,             &
                 roughness_length, surface_pressure, timestep_scheme, tsc,      &
-                z0h_factor
+                z0h_factor, time_since_reference_point
 
      USE indices,                                                              &
-         ONLY:  nxlg, nxrg, nyng, nysg, nzb_s_inner 
+         ONLY:  nbgp, nxlg, nxrg, nyng, nysg, nzb, nzb_s_inner 
 
      USE kinds
@@ -101,5 +101,5 @@
 
      USE radiation_model_mod,                                                  &
-         ONLY:  irad_scheme, rad_net, rad_sw_in, sigma_sb
+         ONLY:  radiation_scheme, rad_net, rad_sw_in, sigma_sb
 
      USE statistics,                                                           &
@@ -243,4 +243,5 @@
               qsws_veg_eb,      & !: surface flux of latent heat (vegetation portion)
               qsws_veg_eb_av,   & !: average of qsws_veg_eb
+              rad_net_l,        & !: local copy of rad_net (net radiation at surface)
               r_a,              & !: aerodynamic resistance 
               r_a_av,           & !: avergae of r_a
@@ -276,6 +277,4 @@
               t_soil_av, t_soil_1, t_soil_2,                                   &
               m_soil_av, m_soil_1, m_soil_2
-
-
 #endif
 
@@ -289,39 +288,39 @@
 !
 !-- Predefined Land surface classes (veg_type)
-    CHARACTER(26), DIMENSION(0:19) :: veg_type_name = (/          &
-                                   'user defined',                & ! 0 
-                                   'crops, mixed farming',        & !  1
-                                   'short grass',                 & !  2
-                                   'evergreen needleleaf trees',  & !  3
-                                   'deciduous needleleaf trees',  & !  4
-                                   'evergreen broadleaf trees' ,  & !  5
-                                   'deciduous broadleaf trees',   & !  6
-                                   'tall grass',                  & !  7
-                                   'desert',                      & !  8
-                                   'tundra',                      & !  9
-                                   'irrigated crops',             & ! 10
-                                   'semidesert',                  & ! 11
-                                   'ice caps and glaciers' ,      & ! 12
-                                   'bogs and marshes',            & ! 13
-                                   'inland water',                & ! 14
-                                   'ocean',                       & ! 15
-                                   'evergreen shrubs',            & ! 16
-                                   'deciduous shrubs',            & ! 17
-                                   'mixed forest/woodland',       & ! 18
-                                   'interrupted forest'           & ! 19
-                                                       /)
+    CHARACTER(26), DIMENSION(0:19), PARAMETER :: veg_type_name = (/ &
+                                   'user defined',                  & ! 0 
+                                   'crops, mixed farming',          & !  1
+                                   'short grass',                   & !  2
+                                   'evergreen needleleaf trees',    & !  3
+                                   'deciduous needleleaf trees',    & !  4
+                                   'evergreen broadleaf trees' ,    & !  5
+                                   'deciduous broadleaf trees',     & !  6
+                                   'tall grass',                    & !  7
+                                   'desert',                        & !  8
+                                   'tundra',                        & !  9
+                                   'irrigated crops',               & ! 10
+                                   'semidesert',                    & ! 11
+                                   'ice caps and glaciers' ,        & ! 12
+                                   'bogs and marshes',              & ! 13
+                                   'inland water',                  & ! 14
+                                   'ocean',                         & ! 15
+                                   'evergreen shrubs',              & ! 16
+                                   'deciduous shrubs',              & ! 17
+                                   'mixed forest/woodland',         & ! 18
+                                   'interrupted forest'             & ! 19
+                                                                 /)
 
 !
 !-- Soil model classes (soil_type)
-    CHARACTER(12), DIMENSION(0:7) :: soil_type_name = (/ &
-                                   'user defined',        & ! 0 
-                                   'coarse',              & ! 1
-                                   'medium',              & ! 2
-                                   'medium-fine',         & ! 3
-                                   'fine',                & ! 4
-                                   'very fine' ,          & ! 5
-                                   'organic',             & ! 6
-                                   'loamy (CH)'           & ! 7
-                                                        /)
+    CHARACTER(12), DIMENSION(0:7), PARAMETER :: soil_type_name = (/ &
+                                   'user defined',                  & ! 0 
+                                   'coarse',                        & ! 1
+                                   'medium',                        & ! 2
+                                   'medium-fine',                   & ! 3
+                                   'fine',                          & ! 4
+                                   'very fine' ,                    & ! 5
+                                   'organic',                       & ! 6
+                                   'loamy (CH)'                     & ! 7
+                                                                 /)
 !
 !-- Land surface parameters according to the respective classes (veg_type)
@@ -330,96 +329,96 @@
 !-- Land surface parameters I
 !--                          r_canopy_min,     lai,   c_veg,     g_d
-    REAL(wp), DIMENSION(0:3,1:19) :: veg_pars = RESHAPE( (/           &
-                                 180.0_wp, 3.00_wp, 0.90_wp, 0.00_wp, & !  1
-                                 110.0_wp, 2.00_wp, 0.85_wp, 0.00_wp, & !  2
-                                 500.0_wp, 5.00_wp, 0.90_wp, 0.03_wp, & !  3
-                                 500.0_wp, 5.00_wp, 0.90_wp, 0.03_wp, & !  4
-                                 175.0_wp, 5.00_wp, 0.90_wp, 0.03_wp, & !  5
-                                 240.0_wp, 6.00_wp, 0.99_wp, 0.13_wp, & !  6
-                                 100.0_wp, 2.00_wp, 0.70_wp, 0.00_wp, & !  7
-                                 250.0_wp, 0.05_wp, 0.00_wp, 0.00_wp, & !  8
-                                  80.0_wp, 1.00_wp, 0.50_wp, 0.00_wp, & !  9
-                                 180.0_wp, 3.00_wp, 0.90_wp, 0.00_wp, & ! 10
-                                 150.0_wp, 0.50_wp, 0.10_wp, 0.00_wp, & ! 11
-                                   0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 12
-                                 240.0_wp, 4.00_wp, 0.60_wp, 0.00_wp, & ! 13
-                                   0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 14
-                                   0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 15
-                                 225.0_wp, 3.00_wp, 0.50_wp, 0.00_wp, & ! 16
-                                 225.0_wp, 1.50_wp, 0.50_wp, 0.00_wp, & ! 17
-                                 250.0_wp, 5.00_wp, 0.90_wp, 0.03_wp, & ! 18
-                                 175.0_wp, 2.50_wp, 0.90_wp, 0.03_wp  & ! 19
+    REAL(wp), DIMENSION(0:3,1:19), PARAMETER :: veg_pars = RESHAPE( (/ &
+                                 180.0_wp, 3.00_wp, 0.90_wp, 0.00_wp,  & !  1
+                                 110.0_wp, 2.00_wp, 0.85_wp, 0.00_wp,  & !  2
+                                 500.0_wp, 5.00_wp, 0.90_wp, 0.03_wp,  & !  3
+                                 500.0_wp, 5.00_wp, 0.90_wp, 0.03_wp,  & !  4
+                                 175.0_wp, 5.00_wp, 0.90_wp, 0.03_wp,  & !  5
+                                 240.0_wp, 6.00_wp, 0.99_wp, 0.13_wp,  & !  6
+                                 100.0_wp, 2.00_wp, 0.70_wp, 0.00_wp,  & !  7
+                                 250.0_wp, 0.05_wp, 0.00_wp, 0.00_wp,  & !  8
+                                  80.0_wp, 1.00_wp, 0.50_wp, 0.00_wp,  & !  9
+                                 180.0_wp, 3.00_wp, 0.90_wp, 0.00_wp,  & ! 10
+                                 150.0_wp, 0.50_wp, 0.10_wp, 0.00_wp,  & ! 11
+                                   0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp,  & ! 12
+                                 240.0_wp, 4.00_wp, 0.60_wp, 0.00_wp,  & ! 13
+                                   0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp,  & ! 14
+                                   0.0_wp, 0.00_wp, 0.00_wp, 0.00_wp,  & ! 15
+                                 225.0_wp, 3.00_wp, 0.50_wp, 0.00_wp,  & ! 16
+                                 225.0_wp, 1.50_wp, 0.50_wp, 0.00_wp,  & ! 17
+                                 250.0_wp, 5.00_wp, 0.90_wp, 0.03_wp,  & ! 18
+                                 175.0_wp, 2.50_wp, 0.90_wp, 0.03_wp   & ! 19
                                  /), (/ 4, 19 /) )
 
 !
 !-- Land surface parameters II          z0,         z0h
-    REAL(wp), DIMENSION(0:1,1:19) :: roughness_par = RESHAPE( (/ & 
-                                   0.25_wp,  0.25E-2_wp,         & !  1
-                                   0.20_wp,  0.20E-2_wp,         & !  2
-                                   2.00_wp,     2.00_wp,         & !  3
-                                   2.00_wp,     2.00_wp,         & !  4
-                                   2.00_wp,     2.00_wp,         & !  5
-                                   2.00_wp,     2.00_wp,         & !  6
-                                   0.47_wp,  0.47E-2_wp,         & !  7
-                                  0.013_wp, 0.013E-2_wp,         & !  8
-                                  0.034_wp, 0.034E-2_wp,         & !  9
-                                    0.5_wp,  0.50E-2_wp,         & ! 10
-                                   0.17_wp,  0.17E-2_wp,         & ! 11
-                                 1.3E-3_wp,   1.3E-4_wp,         & ! 12
-                                   0.83_wp,  0.83E-2_wp,         & ! 13
-                                   0.00_wp,  0.00E-2_wp,         & ! 14
-                                   0.00_wp,  0.00E-2_wp,         & ! 15
-                                   0.10_wp,  0.10E-2_wp,         & ! 16
-                                   0.25_wp,  0.25E-2_wp,         & ! 17
-                                   2.00_wp,  2.00E-2_wp,         & ! 18
-                                   1.10_wp,  1.10E-2_wp          & ! 19
+    REAL(wp), DIMENSION(0:1,1:19), PARAMETER :: roughness_par = RESHAPE( (/ & 
+                                   0.25_wp,  0.25E-2_wp,                    & !  1
+                                   0.20_wp,  0.20E-2_wp,                    & !  2
+                                   2.00_wp,     2.00_wp,                    & !  3
+                                   2.00_wp,     2.00_wp,                    & !  4
+                                   2.00_wp,     2.00_wp,                    & !  5
+                                   2.00_wp,     2.00_wp,                    & !  6
+                                   0.47_wp,  0.47E-2_wp,                    & !  7
+                                  0.013_wp, 0.013E-2_wp,                    & !  8
+                                  0.034_wp, 0.034E-2_wp,                    & !  9
+                                    0.5_wp,  0.50E-2_wp,                    & ! 10
+                                   0.17_wp,  0.17E-2_wp,                    & ! 11
+                                 1.3E-3_wp,   1.3E-4_wp,                    & ! 12
+                                   0.83_wp,  0.83E-2_wp,                    & ! 13
+                                   0.00_wp,  0.00E-2_wp,                    & ! 14
+                                   0.00_wp,  0.00E-2_wp,                    & ! 15
+                                   0.10_wp,  0.10E-2_wp,                    & ! 16
+                                   0.25_wp,  0.25E-2_wp,                    & ! 17
+                                   2.00_wp,  2.00E-2_wp,                    & ! 18
+                                   1.10_wp,  1.10E-2_wp                     & ! 19
                                  /), (/ 2, 19 /) )
 
 !
 !-- Land surface parameters III lambda_surface_s, lambda_surface_u, f_sw_in
-    REAL(wp), DIMENSION(0:2,1:19) :: surface_pars = RESHAPE( (/           &
-                                      10.0_wp,       10.0_wp, 0.05_wp, & !  1
-                                      10.0_wp,       10.0_wp, 0.05_wp, & !  2
-                                      20.0_wp,       15.0_wp, 0.03_wp, & !  3
-                                      20.0_wp,       15.0_wp, 0.03_wp, & !  4
-                                      20.0_wp,       15.0_wp, 0.03_wp, & !  5
-                                      20.0_wp,       15.0_wp, 0.03_wp, & !  6
-                                      10.0_wp,       10.0_wp, 0.05_wp, & !  7
-                                      15.0_wp,       15.0_wp, 0.00_wp, & !  8
-                                      10.0_wp,       10.0_wp, 0.05_wp, & !  9
-                                      10.0_wp,       10.0_wp, 0.05_wp, & ! 10 
-                                      10.0_wp,       10.0_wp, 0.05_wp, & ! 11
-                                      58.0_wp,       58.0_wp, 0.00_wp, & ! 12
-                                      10.0_wp,       10.0_wp, 0.05_wp, & ! 13 
-                                    1.0E20_wp,     1.0E20_wp, 0.00_wp, & ! 14
-                                    1.0E20_wp,     1.0E20_wp, 0.00_wp, & ! 15
-                                      10.0_wp,       10.0_wp, 0.05_wp, & ! 16
-                                      10.0_wp,       10.0_wp, 0.05_wp, & ! 17
-                                      20.0_wp,       15.0_wp, 0.03_wp, & ! 18
-                                      20.0_wp,       15.0_wp, 0.03_wp  & ! 19
+    REAL(wp), DIMENSION(0:2,1:19), PARAMETER :: surface_pars = RESHAPE( (/ &
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & !  1
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & !  2
+                                      20.0_wp,       15.0_wp, 0.03_wp,     & !  3
+                                      20.0_wp,       15.0_wp, 0.03_wp,     & !  4
+                                      20.0_wp,       15.0_wp, 0.03_wp,     & !  5
+                                      20.0_wp,       15.0_wp, 0.03_wp,     & !  6
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & !  7
+                                      15.0_wp,       15.0_wp, 0.00_wp,     & !  8
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & !  9
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & ! 10 
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & ! 11
+                                      58.0_wp,       58.0_wp, 0.00_wp,     & ! 12
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & ! 13 
+                                    1.0E20_wp,     1.0E20_wp, 0.00_wp,     & ! 14
+                                    1.0E20_wp,     1.0E20_wp, 0.00_wp,     & ! 15
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & ! 16
+                                      10.0_wp,       10.0_wp, 0.05_wp,     & ! 17
+                                      20.0_wp,       15.0_wp, 0.03_wp,     & ! 18
+                                      20.0_wp,       15.0_wp, 0.03_wp      & ! 19
                                       /), (/ 3, 19 /) )
 
 !
 !-- Root distribution (sum = 1)  level 1, level 2, level 3, level 4,
-    REAL(wp), DIMENSION(0:3,1:19) :: root_distribution = RESHAPE( (/ &
-                                 0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp, & !  1
-                                 0.35_wp, 0.38_wp, 0.23_wp, 0.04_wp, & !  2
-                                 0.26_wp, 0.39_wp, 0.29_wp, 0.06_wp, & !  3
-                                 0.26_wp, 0.38_wp, 0.29_wp, 0.07_wp, & !  4
-                                 0.24_wp, 0.38_wp, 0.31_wp, 0.07_wp, & !  5
-                                 0.25_wp, 0.34_wp, 0.27_wp, 0.14_wp, & !  6
-                                 0.27_wp, 0.27_wp, 0.27_wp, 0.09_wp, & !  7
-                                 1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & !  8
-                                 0.47_wp, 0.45_wp, 0.08_wp, 0.00_wp, & !  9
-                                 0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp, & ! 10
-                                 0.17_wp, 0.31_wp, 0.33_wp, 0.19_wp, & ! 11
-                                 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 12
-                                 0.25_wp, 0.34_wp, 0.27_wp, 0.11_wp, & ! 13
-                                 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 14
-                                 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 15
-                                 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 16 
-                                 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 17 
-                                 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp, & ! 18
-                                 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp  & ! 19
+    REAL(wp), DIMENSION(0:3,1:19), PARAMETER :: root_distribution = RESHAPE( (/ &
+                                 0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp,            & !  1
+                                 0.35_wp, 0.38_wp, 0.23_wp, 0.04_wp,            & !  2
+                                 0.26_wp, 0.39_wp, 0.29_wp, 0.06_wp,            & !  3
+                                 0.26_wp, 0.38_wp, 0.29_wp, 0.07_wp,            & !  4
+                                 0.24_wp, 0.38_wp, 0.31_wp, 0.07_wp,            & !  5
+                                 0.25_wp, 0.34_wp, 0.27_wp, 0.14_wp,            & !  6
+                                 0.27_wp, 0.27_wp, 0.27_wp, 0.09_wp,            & !  7
+                                 1.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,            & !  8
+                                 0.47_wp, 0.45_wp, 0.08_wp, 0.00_wp,            & !  9
+                                 0.24_wp, 0.41_wp, 0.31_wp, 0.04_wp,            & ! 10
+                                 0.17_wp, 0.31_wp, 0.33_wp, 0.19_wp,            & ! 11
+                                 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,            & ! 12
+                                 0.25_wp, 0.34_wp, 0.27_wp, 0.11_wp,            & ! 13
+                                 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,            & ! 14
+                                 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp,            & ! 15
+                                 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp,            & ! 16 
+                                 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp,            & ! 17 
+                                 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp,            & ! 18
+                                 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp             & ! 19
                                  /), (/ 4, 19 /) )
 
@@ -429,5 +428,5 @@
 !
 !-- Soil parameters I           alpha_vg,      l_vg,    n_vg, gamma_w_sat
-    REAL(wp), DIMENSION(0:3,1:7) :: soil_pars = RESHAPE( (/                &
+    REAL(wp), DIMENSION(0:3,1:7), PARAMETER :: soil_pars = RESHAPE( (/     &
                                  3.83_wp,  1.250_wp, 1.38_wp,  6.94E-6_wp, & ! 1
                                  3.14_wp, -2.342_wp, 1.28_wp,  1.16E-6_wp, & ! 2
@@ -441,5 +440,5 @@
 !
 !-- Soil parameters II              m_sat,     m_fc,   m_wilt,    m_res  
-    REAL(wp), DIMENSION(0:3,1:7) :: m_soil_pars = RESHAPE( (/            &
+    REAL(wp), DIMENSION(0:3,1:7), PARAMETER :: m_soil_pars = RESHAPE( (/ &
                                  0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp, & ! 1
                                  0.439_wp, 0.347_wp, 0.151_wp, 0.010_wp, & ! 2
@@ -490,5 +489,4 @@
 !-- Public prognostic variables
     PUBLIC m_liq_eb, m_liq_eb_av, m_soil, m_soil_av, t_soil, t_soil_av
-
 
     INTERFACE init_lsm
@@ -573,4 +571,5 @@
        ALLOCATE ( qsws_liq_eb(nysg:nyng,nxlg:nxrg) )
        ALLOCATE ( qsws_veg_eb(nysg:nyng,nxlg:nxrg) )
+       ALLOCATE ( rad_net_l(nysg:nyng,nxlg:nxrg) )
        ALLOCATE ( r_a(nysg:nyng,nxlg:nxrg) )
        ALLOCATE ( r_canopy(nysg:nyng,nxlg:nxrg) )
@@ -583,5 +582,5 @@
 #if ! defined( __nopointer )
 !
-!-- Initial assignment of the pointers
+!--    Initial assignment of the pointers
        t_soil    => t_soil_1;    t_soil_p    => t_soil_2
        t_surface => t_surface_1; t_surface_p => t_surface_2
@@ -890,4 +889,5 @@
 !
 !--    Add timeseries for land surface model
+
        dots_label(dots_num+1) = "ghf_eb"
        dots_label(dots_num+2) = "shf_eb"
@@ -904,5 +904,4 @@
        dots_soil = dots_num + 1
        dots_num  = dots_num + 8
-
 
        RETURN
@@ -957,4 +956,5 @@
        exn = ( surface_pressure / 1000.0_wp )**0.286_wp
 
+       
 
        DO i = nxlg, nxrg
@@ -984,7 +984,8 @@
 !--          f1: correction for incoming shortwave radiation (stomata close at 
 !--          night)
-             IF ( irad_scheme /= 0 )  THEN
-                f1 = MIN(1.0_wp, ( 0.004_wp * rad_sw_in(j,i) + 0.05_wp ) /     &
-                              (0.81_wp * (0.004_wp * rad_sw_in(j,i) + 1.0_wp) ))
+             IF ( radiation_scheme /= 'constant' )  THEN
+                f1 = MIN( 1.0_wp, ( 0.004_wp * rad_sw_in(k,j,i) + 0.05_wp ) /&
+                              (0.81_wp * (0.004_wp * rad_sw_in(k,j,i)        &
+                               + 1.0_wp)) )
              ELSE
                 f1 = 1.0_wp
@@ -1112,5 +1113,5 @@
 !
 !--          Add LW up so that it can be removed in prognostic equation
-             rad_net(j,i) = rad_net(j,i) + sigma_sb * t_surface(j,i) ** 4
+             rad_net_l(j,i) = rad_net(j,i) + sigma_sb * t_surface(j,i) ** 4
 
              IF ( humidity )  THEN
@@ -1118,5 +1119,5 @@
 !
 !--             Numerator of the prognostic equation
-                coef_1 = rad_net(j,i) + 3.0_wp * sigma_sb * t_surface(j,i) ** 4&
+                coef_1 = rad_net_l(j,i) + 3.0_wp * sigma_sb * t_surface(j,i) ** 4&
                          + f_shf / exn * T_1 + f_qsws * ( q_p(k+1,j,i) - q_s   &
                          + dq_s_dt * t_surface(j,i) ) + lambda_surface         &
@@ -1132,5 +1133,5 @@
 !
 !--             Numerator of the prognostic equation
-                coef_1 = rad_net(j,i) + 3.0_wp * sigma_sb * t_surface(j,i) ** 4&
+                coef_1 = rad_net_l(j,i) + 3.0_wp * sigma_sb * t_surface(j,i) ** 4&
                          + f_shf / exn * T_1 + lambda_surface                  &
                          * t_soil(nzb_soil,j,i)
@@ -1175,5 +1176,5 @@
 !
 !--          Calculate fluxes
-             rad_net(j,i)   = rad_net(j,i) + 3.0_wp * sigma_sb                 &
+             rad_net_l(j,i)   = rad_net_l(j,i) + 3.0_wp * sigma_sb                 &
                               * t_surface(j,i)**4 - 4.0_wp * sigma_sb          &
                               * t_surface(j,i)**3 * t_surface_p(j,i)
@@ -1621,14 +1622,4 @@
           CASE ( 0 )
 
-             t_surface = t_surface_p
-             t_soil    = t_soil_p
-             IF ( humidity )  THEN
-                m_soil    = m_soil_p
-                m_liq_eb  = m_liq_eb_p
-             ENDIF
-
-
-          CASE ( 1 )
-
              t_surface  => t_surface_1; t_surface_p  => t_surface_2
              t_soil     => t_soil_1;    t_soil_p     => t_soil_2
@@ -1638,4 +1629,14 @@
              ENDIF
 
+
+          CASE ( 1 )
+
+             t_surface  => t_surface_2; t_surface_p  => t_surface_1
+             t_soil     => t_soil_2;    t_soil_p     => t_soil_1
+             IF ( humidity )  THEN
+                m_soil    => m_soil_2;   m_soil_p    => m_soil_1
+                m_liq_eb  => m_liq_eb_2; m_liq_eb_p  => m_liq_eb_1
+             ENDIF
+
        END SELECT
 #endif
Index: /palm/trunk/SOURCE/netcdf.f90
===================================================================
--- /palm/trunk/SOURCE/netcdf.f90	(revision 1584)
+++ /palm/trunk/SOURCE/netcdf.f90	(revision 1585)
@@ -148,4 +148,7 @@
     USE profil_parameter,                                                       &
         ONLY:  crmax, cross_profiles, dopr_index,profile_columns, profile_rows
+
+    USE radiation_model_mod,                                                    &
+        ONLY:  rad_lw_in, rad_lw_out, rad_sw_in, rad_sw_out
 
     USE spectrum,                                                               &
@@ -523,5 +526,6 @@
                 CASE ( 'e', 'lpt', 'nr', 'p', 'pc', 'pr', 'prr', 'pt', 'q',&
                        'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv',    &
-                       'rho', 's', 'sa', 'vpt' )
+                       'rho', 's', 'sa', 'vpt', 'rad_lw_in', 'rad_lw_out', &
+                       'rad_sw_in', 'rad_sw_out' )
 
                    grid_x = 'x'
@@ -1103,5 +1107,6 @@
                 CASE ( 'e', 'lpt', 'nr', 'p', 'pc', 'pr', 'prr', 'pt', 'q',   &
                        'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv', 'rho',&
-                       's', 'sa', 'vpt' )
+                       's', 'sa', 'vpt' , 'rad_lw_in', 'rad_lw_out',          &
+                       'rad_sw_in', 'rad_sw_out' )
 
                    grid_x = 'x'
@@ -1756,5 +1761,6 @@
                              'prr_xy', 'pt_xy', 'q_xy', 'qc_xy', 'ql_xy',        &
                              'ql_c_xy', 'ql_v_xy', 'ql_vp_xy', 'qr_xy', 'qv_xy', &
-                             'rho_xy', 's_xy', 'sa_xy', 'vpt_xy' )
+                             'rho_xy', 's_xy', 'sa_xy', 'vpt_xy', 'rad_lw_in_xy',&
+                             'rad_lw_out_xy', 'rad_sw_in_xy', 'rad_sw_out_xy' )
 
                          grid_x = 'x'
@@ -2439,5 +2445,6 @@
                           'prr_xz', 'pt_xz', 'q_xz', 'qc_xz', 'ql_xz',         &
                           'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qr_xz', 'qv_xz',  &
-                          'rho_xz', 's_xz', 'sa_xz', 'vpt_xz' )
+                          'rho_xz', 's_xz', 'sa_xz', 'vpt_xz' , 'rad_lw_in_xz',&
+                             'rad_lw_out_xz', 'rad_sw_in_xz', 'rad_sw_out_xz' )
 
                       grid_x = 'x'
@@ -3115,5 +3122,6 @@
                           'prr_yz', 'pt_yz', 'q_yz', 'qc_yz', 'ql_yz',        &
                           'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qr_yz', 'qv_yz', &
-                          'rho_yz', 's_yz', 'sa_yz', 'vpt_yz' )
+                          'rho_yz', 's_yz', 'sa_yz', 'vpt_yz', 'rad_lw_in_yz',&
+                             'rad_lw_out_yz', 'rad_sw_in_yz', 'rad_sw_out_yz' )
 
                       grid_x = 'x'
Index: /palm/trunk/SOURCE/package_parin.f90
===================================================================
--- /palm/trunk/SOURCE/package_parin.f90	(revision 1584)
+++ /palm/trunk/SOURCE/package_parin.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Added several radiation_par parameters
 !
 ! Former revisions:
@@ -144,6 +144,8 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY: albedo, day_init, dt_radiation, lambda, net_radiation, radiation,&
-              radiation_scheme, time_radiation, time_utc_init 
+        ONLY: albedo, albedo_type, albedo_lw_dif, albedo_lw_dir, albedo_sw_dif,&
+              albedo_sw_dir, day_init, constant_albedo, dt_radiation, lambda,  &
+              lw_radiation, net_radiation, radiation, radiation_scheme,        &
+              sw_radiation, time_utc_init
                 
 
@@ -221,6 +223,9 @@
                                   write_particle_statistics
 
-    NAMELIST /radiation_par/      albedo, day_init, dt_radiation, lambda,      &
-                                  net_radiation, radiation_scheme, time_utc_init 
+    NAMELIST /radiation_par/      albedo, albedo_type, albedo_lw_dir,          &
+                                  albedo_lw_dif, albedo_sw_dir, albedo_sw_dif, &
+                                  constant_albedo, day_init, dt_radiation,     &
+                                  lambda, lw_radiation, net_radiation,         &
+                                  radiation_scheme, sw_radiation, time_utc_init 
 
     NAMELIST /spectra_par/        averaging_interval_sp, comp_spectra_level,   &
Index: /palm/trunk/SOURCE/prognostic_equations.f90
===================================================================
--- /palm/trunk/SOURCE/prognostic_equations.f90	(revision 1584)
+++ /palm/trunk/SOURCE/prognostic_equations.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! ------------------
-!
+! Added call for temperature tendency calculation due to radiative flux divergence
 ! 
 ! Former revisions:
@@ -277,4 +277,7 @@
         ONLY:  production_e, production_e_acc
 
+    USE radiation_model_mod,                                                   &
+        ONLY:  radiation, radiation_scheme, radiation_tendency
+
     USE statistics,                                                            &
         ONLY:  hom
@@ -593,4 +596,11 @@
                 CALL subsidence( i, j, tend, pt, pt_init, 2 )
              ENDIF
+
+!
+!--          If required, add tendency due to radiative heating/cooling
+             IF ( radiation .AND. radiation_scheme == 'rrtmg' )  THEN
+                CALL radiation_tendency ( i, j, tend )
+             ENDIF
+
 
              CALL user_actions( i, j, 'pt-tendency' )
@@ -1246,4 +1256,10 @@
             .NOT. use_subsidence_tendencies )  THEN
           CALL subsidence( tend, pt, pt_init, 2 )
+       ENDIF
+
+!
+!--    If required, add tendency due to radiative heating/cooling
+       IF ( radiation .AND. radiation_scheme == 'rrtmg' )  THEN
+          CALL radiation_tendency ( tend )
        ENDIF
 
Index: /palm/trunk/SOURCE/radiation_model.f90
===================================================================
--- /palm/trunk/SOURCE/radiation_model.f90	(revision 1584)
+++ /palm/trunk/SOURCE/radiation_model.f90	(revision 1585)
@@ -15,10 +15,10 @@
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
-! Copyright 1997-2014 Leibniz Universitaet Hannover
+! Copyright 1997-2015 Leibniz Universitaet Hannover
 !--------------------------------------------------------------------------------!
 !
 ! Current revisions:
 ! -----------------
-! 
+! Added support for RRTMG
 ! 
 ! Former revisions:
@@ -40,68 +40,262 @@
 ! Description:
 ! ------------
-! Radiation model(s), to be used e.g. with the land surface scheme
+! Radiation models and interfaces
+! To do: move variable definitions used in init_radiation only to the subroutine
+! as they are no longer required after initialization.
+! Note that many variables have a leading dummy dimension (0:0) in order to
+! match the assume-size shape expected by the RRTMG model
+!
+! To do:
+! - Output of full column vertical profiles used in RRTMG
+! - Output of other rrtm arrays (such as volume mixing ratios)
+! - Adapt for use with topography
+! - Remove 3D dummy arrays (such as clear-sky output)
 !------------------------------------------------------------------------------!
 
     USE arrays_3d,                                                             &
-        ONLY: pt
+        ONLY:  hyp, pt, q, ql, zw
+
+    USE cloud_parameters,                                                      &
+        ONLY:  cp, l_v, nc_const, rho_l, sigma_gc  
+
+    USE constants,                                                             &
+        ONLY:  pi
 
     USE control_parameters,                                                    &
-        ONLY: phi, surface_pressure, time_since_reference_point
+        ONLY:  cloud_droplets, cloud_physics, g, initializing_actions,         &
+               large_scale_forcing, lsf_surf, phi, pt_surface,                 &
+               surface_pressure, time_since_reference_point
 
     USE indices,                                                               &
-        ONLY:  nxlg, nxrg, nyng, nysg, nzb_s_inner
+        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb_s_inner, nzb, nzt
 
     USE kinds
+
+    USE netcdf
 
     USE netcdf_control,                                                        &
         ONLY:  dots_label, dots_num, dots_unit
 
+#if defined ( __rrtmg )
+    USE parrrsw,                                                               &
+        ONLY:  naerec, nbndsw
+
+    USE parrrtm,                                                               &
+        ONLY:  nbndlw
+
+    USE rrtmg_lw_init,                                                         &
+        ONLY:  rrtmg_lw_ini
+
+    USE rrtmg_sw_init,                                                         &
+        ONLY:  rrtmg_sw_ini
+
+    USE rrtmg_lw_rad,                                                          &
+        ONLY:  rrtmg_lw
+
+    USE rrtmg_sw_rad,                                                          &
+        ONLY:  rrtmg_sw
+#endif
+
+
 
     IMPLICIT NONE
 
-    CHARACTER(10) :: radiation_scheme = 'clear-sky' ! 'constant', 'clear-sky', or 'rrtm'
-
-    INTEGER(iwp) :: i, j, k
-
-
-    INTEGER(iwp) :: day_init     = 172,  & !: day of the year at model start (21/06)
-                    dots_rad     = 0,    & !: starting index for timeseries output 
-                    irad_scheme  = 0
-
-    LOGICAL :: radiation = .FALSE.  !: flag parameter indicating wheather the radiation model is used
-
-    REAL(wp), PARAMETER :: sw_0 = 1368.0_wp, &    !: solar constant  
-                           pi = 3.14159265358979323_wp, &
-                           sigma_sb  = 5.67E-8_wp !: Stefan-Boltzmann constant
+    CHARACTER(10) :: radiation_scheme = 'clear-sky' ! 'constant', 'clear-sky', or 'rrtmg'
+
+!
+!-- Predefined Land surface classes (albedo_type) after Briegleb (1992)
+    CHARACTER(37), DIMENSION(0:16), PARAMETER :: albedo_type_name = (/    &
+                                   'user defined',                         & !  0 
+                                   'ocean',                                & !  1
+                                   'mixed farming, tall grassland',        & !  2
+                                   'tall/medium grassland',                & !  3 
+                                   'evergreen shrubland',                  & !  4
+                                   'short grassland/meadow/shrubland',     & !  5
+                                   'evergreen needleleaf forest',          & !  6
+                                   'mixed deciduous evergreen forest',     & !  7
+                                   'deciduous forest',                     & !  8
+                                   'tropical evergreen broadleaved forest',& !  9
+                                   'medium/tall grassland/woodland',       & ! 10
+                                   'desert, sandy',                        & ! 11 
+                                   'desert, rocky',                        & ! 12 
+                                   'tundra',                               & ! 13
+                                   'landice',                              & ! 14 
+                                   'sea ice',                              & ! 15 
+                                   'snow'                                  & ! 16
+                                                         /)
+
+    INTEGER(iwp) :: albedo_type  = 5,    & !: Albedo surface type (default: short grassland)
+                    day,                 & !: current day of the year
+                    day_init     = 172,  & !: day of the year at model start (21/06)
+                    dots_rad     = 0       !: starting index for timeseries output 
+
+
+
+
+
+
+    LOGICAL ::  constant_albedo = .FALSE., & !: flag parameter indicating whether the albedo may change depending on zenith
+                lw_radiation = .TRUE.,     & !: flag parameter indicing whether longwave radiation shall be calculated
+                radiation = .FALSE.,       & !: flag parameter indicating whether the radiation model is used
+                sun_up    = .TRUE.,        & !: flag parameter indicating whether the sun is up or down
+                sw_radiation = .TRUE.        !: flag parameter indicing whether shortwave radiation shall be calculated
+
+    REAL(wp), PARAMETER :: sigma_sb       = 5.67E-8_wp, & !: Stefan-Boltzmann constant
+                           solar_constant = 1368.0_wp     !: solar constant at top of atmosphere
  
-    REAL(wp) :: albedo = 0.2_wp,             & !: NAMELIST alpha
-                dt_radiation = 0.0_wp,       & !: radiation model timestep
-                exn,                         & !: Exner function
-                lon = 0.0_wp,                & !: longitude in radians
-                lat = 0.0_wp,                & !: latitude in radians
-                decl_1,                      & !: declination coef. 1
-                decl_2,                      & !: declination coef. 2
-                decl_3,                      & !: declination coef. 3
-                time_utc,                    & !: current time in UTC
-                time_utc_init = 43200.0_wp,  & !: UTC time at model start (noon)
-                day,                         & !: current day of the year
-                lambda = 0.0_wp,             & !: longitude in degrees
-                declination,                 & !: solar declination angle
-                net_radiation = 0.0_wp,      & !: net radiation at surface
-                hour_angle,                  & !: solar hour angle
-                time_radiation = 0.0_wp,     &
-                zenith,                      & !: solar zenith angle
-                sky_trans                      !: sky transmissivity
+    REAL(wp) :: albedo = 9999999.9_wp,        & !: NAMELIST alpha
+                albedo_lw_dif = 9999999.9_wp, & !: NAMELIST aldif
+                albedo_lw_dir = 9999999.9_wp, & !: NAMELIST aldir
+                albedo_sw_dif = 9999999.9_wp, & !: NAMELIST asdif
+                albedo_sw_dir = 9999999.9_wp, & !: NAMELIST asdir
+                dt_radiation = 0.0_wp,        & !: radiation model timestep
+                emissivity = 0.95_wp,         & !: NAMELIST surface emissivity
+                exn,                          & !: Exner function
+                lon = 0.0_wp,                 & !: longitude in radians
+                lat = 0.0_wp,                 & !: latitude in radians
+                decl_1,                       & !: declination coef. 1
+                decl_2,                       & !: declination coef. 2
+                decl_3,                       & !: declination coef. 3
+                time_utc,                     & !: current time in UTC
+                time_utc_init = 43200.0_wp,   & !: UTC time at model start (noon)
+                lambda = 0.0_wp,              & !: longitude in degrees
+                net_radiation = 0.0_wp,       & !: net radiation at surface
+                time_radiation = 0.0_wp,      & !: time since last call of radiation code
+                sky_trans                       !: sky transmissivity
+
+
+    REAL(wp), DIMENSION(0:0) ::  zenith        !: solar zenith angle
 
     REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
-                alpha,                       & !: surface albedo
+                alpha,                       & !: surface broadband albedo (used for clear-sky scheme)
                 rad_net,                     & !: net radiation at the surface
-                rad_net_av,                  & !: average of rad_net
-                rad_lw_in,                   & !: incoming longwave radiation
-                rad_lw_out,                  & !: outgoing longwave radiation
-                rad_sw_in,                   & !: incoming shortwave radiation
-                rad_sw_in_av,                & !: average of rad_sw_in
-                rad_sw_out                     !: outgoing shortwave radiation
-
+                rad_net_av                     !: average of rad_net
+
+!
+!-- Land surface albedos for solar zenith angle of 60Â° after Briegleb (1992)     
+!-- (shortwave, longwave, broadband):   sw,      lw,      bb,
+    REAL(wp), DIMENSION(0:2,1:15), PARAMETER :: albedo_pars = RESHAPE( (/& 
+                                   0.06_wp, 0.06_wp, 0.06_wp,            & !  1
+                                   0.09_wp, 0.28_wp, 0.19_wp,            & !  2
+                                   0.11_wp, 0.33_wp, 0.23_wp,            & !  3
+                                   0.11_wp, 0.33_wp, 0.23_wp,            & !  4
+                                   0.14_wp, 0.34_wp, 0.25_wp,            & !  5
+                                   0.06_wp, 0.22_wp, 0.14_wp,            & !  6
+                                   0.06_wp, 0.27_wp, 0.17_wp,            & !  7
+                                   0.06_wp, 0.31_wp, 0.19_wp,            & !  8
+                                   0.06_wp, 0.22_wp, 0.14_wp,            & !  9
+                                   0.06_wp, 0.28_wp, 0.18_wp,            & ! 10
+                                   0.35_wp, 0.51_wp, 0.43_wp,            & ! 11
+                                   0.24_wp, 0.40_wp, 0.32_wp,            & ! 12
+                                   0.10_wp, 0.27_wp, 0.19_wp,            & ! 13
+                                   0.90_wp, 0.65_wp, 0.77_wp,            & ! 14
+                                   0.95_wp, 0.70_wp, 0.82_wp             & ! 15
+                                 /), (/ 3, 15 /) )
+
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
+                        rad_sw_in,                     & !: incoming shortwave radiation (W/m2)
+                        rad_sw_in_av,                  & !: average of rad_sw_in
+                        rad_sw_out,                    & !: outgoing shortwave radiation (W/m2)
+                        rad_sw_out_av,                 & !: average of rad_sw_out
+                        rad_lw_in,                     & !: incoming longwave radiation (W/m2)
+                        rad_lw_in_av,                  & !: average of rad_lw_in
+                        rad_lw_out,                    & !: outgoing longwave radiation (W/m2)
+                        rad_lw_out_av                    !: average of rad_lw_out
+
+!
+!-- Variables and parameters used in RRTMG only
+#if defined ( __rrtmg )
+    CHARACTER(LEN=12) :: rrtm_input_file = "RAD_SND_DATA" !: name of the NetCDF input file (sounding data)
+
+
+!
+!-- Flag parameters for RRTMGS (should not be changed)
+    INTEGER(iwp), PARAMETER :: rrtm_inflglw  = 2, & !: flag for lw cloud optical properties (0,1,2)
+                               rrtm_iceflglw = 0, & !: flag for lw ice particle specifications (0,1,2,3)
+                               rrtm_liqflglw = 1, & !: flag for lw liquid droplet specifications
+                               rrtm_inflgsw  = 2, & !: flag for sw cloud optical properties (0,1,2)
+                               rrtm_iceflgsw = 0, & !: flag for sw ice particle specifications (0,1,2,3)
+                               rrtm_liqflgsw = 1    !: flag for sw liquid droplet specifications
+
+!
+!-- The following variables should be only changed with care, as this will 
+!-- require further setting of some variables, which is currently not
+!-- implemented (aerosols, ice phase).
+    INTEGER(iwp) :: nzt_rad,           & !: upper vertical limit for radiation calculations
+                    rrtm_icld = 0,     & !: cloud flag (0: clear sky column, 1: cloudy column)
+                    rrtm_iaer = 0,     & !: aerosol option flag (0: no aerosol layers, for lw only: 6 (requires setting of rrtm_sw_ecaer), 10: one or more aerosol layers (not implemented)
+                    rrtm_idrv = 0        !: longwave upward flux calculation option (0,1)
+
+    LOGICAL :: snd_exists = .FALSE.      !: flag parameter to check whether a user-defined input files exists
+
+    REAL(wp), PARAMETER :: mol_weight_air_d_wv = 1.607793_wp !: molecular weight dry air / water vapor
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE :: hyp_snd,     & !: hypostatic pressure from sounding data (hPa)
+                                           q_snd,       & !: specific humidity from sounding data (kg/kg) - dummy at the moment
+                                           rrtm_tsfc,   & !: dummy array for storing surface temperature
+                                           t_snd          !: actual temperature from sounding data (hPa)
+
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldif,         & !: longwave diffuse albedo solar angle of 60Â°
+                                             aldir,         & !: longwave direct albedo solar angle of 60Â°
+                                             asdif,         & !: shortwave diffuse albedo solar angle of 60Â°
+                                             asdir,         & !: shortwave direct albedo solar angle of 60Â°
+                                             rrtm_ccl4vmr,  & !: CCL4 volume mixing ratio (g/mol)
+                                             rrtm_cfc11vmr, & !: CFC11 volume mixing ratio (g/mol)
+                                             rrtm_cfc12vmr, & !: CFC12 volume mixing ratio (g/mol)
+                                             rrtm_cfc22vmr, & !: CFC22 volume mixing ratio (g/mol)
+                                             rrtm_ch4vmr,   & !: CH4 volume mixing ratio
+                                             rrtm_cicewp,   & !: in-cloud ice water path (g/mÂ²)
+                                             rrtm_cldfr,    & !: cloud fraction (0,1)
+                                             rrtm_cliqwp,   & !: in-cloud liquid water path (g/mÂ²)
+                                             rrtm_co2vmr,   & !: CO2 volume mixing ratio (g/mol)
+                                             rrtm_emis,     & !: surface emissivity (0-1)    
+                                             rrtm_h2ovmr,   & !: H2O volume mixing ratio
+                                             rrtm_n2ovmr,   & !: N2O volume mixing ratio
+                                             rrtm_o2vmr,    & !: O2 volume mixing ratio
+                                             rrtm_o3vmr,    & !: O3 volume mixing ratio
+                                             rrtm_play,     & !: pressure layers (hPa, zu-grid)
+                                             rrtm_plev,     & !: pressure layers (hPa, zw-grid)
+                                             rrtm_reice,    & !: cloud ice effective radius (microns)
+                                             rrtm_reliq,    & !: cloud water drop effective radius (microns)
+                                             rrtm_tlay,     & !: actual temperature (K, zu-grid)
+                                             rrtm_tlev,     & !: actual temperature (K, zw-grid)
+                                             rrtm_lwdflx,   & !: RRTM output of incoming longwave radiation flux (W/m2)
+                                             rrtm_lwuflx,   & !: RRTM output of outgoing longwave radiation flux (W/m2)
+                                             rrtm_lwhr,     & !: RRTM output of longwave radiation heating rate (K/d)
+                                             rrtm_lwuflxc,  & !: RRTM output of incoming clear sky longwave radiation flux (W/m2)
+                                             rrtm_lwdflxc,  & !: RRTM output of outgoing clear sky longwave radiation flux (W/m2) 
+                                             rrtm_lwhrc,    & !: RRTM output of incoming longwave clear sky radiation heating rate (K/d)
+                                             rrtm_swdflx,   & !: RRTM output of incoming shortwave radiation flux (W/m2)
+                                             rrtm_swuflx,   & !: RRTM output of outgoing shortwave radiation flux (W/m2)
+                                             rrtm_swhr,     & !: RRTM output of shortwave radiation heating rate (K/d)
+                                             rrtm_swuflxc,  & !: RRTM output of incoming clear sky shortwave radiation flux (W/m2)
+                                             rrtm_swdflxc,  & !: RRTM output of outgoing clear sky shortwave radiation flux (W/m2) 
+                                             rrtm_swhrc       !: RRTM output of incoming shortwave clear sky radiation heating rate (K/d) 
+
+!
+!-- Definition of arrays that are currently not used for calling RRTMG (due to setting of flag parameters)
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  rad_lw_cs_in,   & !: incoming clear sky longwave radiation (W/m2) (not used)
+                                                rad_lw_cs_out,  & !: outgoing clear sky longwave radiation (W/m2) (not used)
+                                                rad_lw_cs_hr,   & !: longwave clear sky radiation heating rate (K/d) (not used)
+                                                rad_lw_hr,      & !: longwave radiation heating rate (K/d)
+                                                rad_sw_cs_in,   & !: incoming clear sky shortwave radiation (W/m2) (not used)
+                                                rad_sw_cs_out,  & !: outgoing clear sky shortwave radiation (W/m2) (not used)
+                                                rad_sw_cs_hr,   & !: shortwave clear sky radiation heating rate (K/d) (not used)
+                                                rad_sw_hr,      & !: shortwave radiation heating rate (K/d)
+                                                rrtm_aldif,     & !: surface albedo for longwave diffuse radiation
+                                                rrtm_aldir,     & !: surface albedo for longwave direct radiation
+                                                rrtm_asdif,     & !: surface albedo for shortwave diffuse radiation
+                                                rrtm_asdir,     & !: surface albedo for shortwave direct radiation
+                                                rrtm_lw_tauaer, & !: lw aerosol optical depth
+                                                rrtm_lw_taucld, & !: lw in-cloud optical depth
+                                                rrtm_sw_taucld, & !: sw in-cloud optical depth
+                                                rrtm_sw_ssacld, & !: sw in-cloud single scattering albedo
+                                                rrtm_sw_asmcld, & !: sw in-cloud asymmetry parameter
+                                                rrtm_sw_fsfcld, & !: sw in-cloud forward scattering fraction
+                                                rrtm_sw_tauaer, & !: sw aerosol optical depth
+                                                rrtm_sw_ssaaer, & !: sw aerosol single scattering albedo
+                                                rrtm_sw_asmaer, & !: sw aerosol asymmetry parameter
+                                                rrtm_sw_ecaer     !: sw aerosol optical detph at 0.55 microns (rrtm_iaer = 6 only)
+#endif
 
     INTERFACE init_radiation
@@ -113,12 +307,12 @@
     END INTERFACE radiation_clearsky
 
-    INTERFACE radiation_constant
-       MODULE PROCEDURE radiation_constant
-    END INTERFACE radiation_constant
-
-    INTERFACE radiation_rrtm
-       MODULE PROCEDURE radiation_rrtm
-    END INTERFACE radiation_rrtm
-
+    INTERFACE radiation_rrtmg
+       MODULE PROCEDURE radiation_rrtmg
+    END INTERFACE radiation_rrtmg
+
+    INTERFACE radiation_tendency
+       MODULE PROCEDURE radiation_tendency
+       MODULE PROCEDURE radiation_tendency_ij
+    END INTERFACE radiation_tendency
 
     SAVE
@@ -126,11 +320,16 @@
     PRIVATE
 
-    PUBLIC albedo, day_init, dots_rad, dt_radiation, init_radiation,           &
-           irad_scheme, lambda, net_radiation, rad_net, rad_net_av, radiation, &
-           radiation_clearsky, radiation_constant, radiation_rrtm,             &
-           radiation_scheme, rad_sw_in, rad_sw_in_av, sigma_sb,                &
-           time_radiation, time_utc_init 
-
-
+    PUBLIC albedo, albedo_type, albedo_type_name, albedo_lw_dif, albedo_lw_dir,&
+           albedo_sw_dif, albedo_sw_dir, constant_albedo, day_init, dots_rad,  &
+           dt_radiation, init_radiation, lambda, lw_radiation, net_radiation,  &
+           rad_net, rad_net_av, radiation, radiation_clearsky,                 &
+           radiation_rrtmg, radiation_scheme, radiation_tendency, rad_lw_in,   &
+           rad_lw_in_av, rad_lw_out, rad_lw_out_av, rad_sw_in, rad_sw_in_av,   &
+           rad_sw_out, rad_sw_out_av, sigma_sb, sw_radiation, time_radiation,  &
+           time_utc_init 
+
+#if defined ( __rrtmg )
+    PUBLIC rrtm_aldif, rrtm_aldir, rrtm_asdif, rrtm_asdir
+#endif
 
  CONTAINS
@@ -143,45 +342,249 @@
     SUBROUTINE init_radiation
     
-
        IMPLICIT NONE
 
-       ALLOCATE ( alpha(nysg:nyng,nxlg:nxrg) )
-       ALLOCATE ( rad_net(nysg:nyng,nxlg:nxrg) )
-       ALLOCATE ( rad_lw_in(nysg:nyng,nxlg:nxrg) )
-       ALLOCATE ( rad_lw_out(nysg:nyng,nxlg:nxrg) )
-       ALLOCATE ( rad_sw_in(nysg:nyng,nxlg:nxrg) )
-       ALLOCATE ( rad_sw_out(nysg:nyng,nxlg:nxrg) )
-
-       rad_sw_in  = 0.0_wp
-       rad_sw_out = 0.0_wp
-       rad_lw_in  = 0.0_wp
-       rad_lw_out = 0.0_wp
-       rad_net    = 0.0_wp
-
-       alpha = albedo
+!
+!--    Allocate array for storing the surface net radiation
+       IF ( .NOT. ALLOCATED ( rad_net ) )  THEN
+          ALLOCATE ( rad_net(nysg:nyng,nxlg:nxrg) )
+          rad_net = 0.0_wp
+       ENDIF
 
 !
 !--    Fix net radiation in case of radiation_scheme = 'constant'
-       IF ( irad_scheme == 0 )  THEN
+       IF ( radiation_scheme == 'constant' )  THEN
           rad_net = net_radiation
-!
-!--    Calculate radiation scheme constants
-       ELSEIF ( irad_scheme == 1 .OR. irad_scheme == 2 )  THEN
+          radiation = .FALSE.
+!
+!--    Calculate orbital constants
+       ELSE
           decl_1 = SIN(23.45_wp * pi / 180.0_wp)
           decl_2 = 2.0_wp * pi / 365.0_wp
           decl_3 = decl_2 * 81.0_wp
-!
-!--       Calculate latitude and longitude angles (lat and lon, respectively)
-          lat = phi * pi / 180.0_wp
-          lon = lambda * pi / 180.0_wp
+          lat    = phi * pi / 180.0_wp
+          lon    = lambda * pi / 180.0_wp
        ENDIF
+
+
+       IF ( radiation_scheme == 'clear-sky' )  THEN
+
+          ALLOCATE ( alpha(nysg:nyng,nxlg:nxrg) )
+
+          IF ( .NOT. ALLOCATED ( rad_sw_in ) )  THEN
+             ALLOCATE ( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+          IF ( .NOT. ALLOCATED ( rad_sw_out ) )  THEN
+             ALLOCATE ( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_sw_in_av ) )  THEN
+             ALLOCATE ( rad_sw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+          IF ( .NOT. ALLOCATED ( rad_sw_out_av ) )  THEN
+             ALLOCATE ( rad_sw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_lw_in ) )  THEN
+             ALLOCATE ( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
+             ALLOCATE ( rad_lw_out(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_lw_in_av ) )  THEN
+             ALLOCATE ( rad_lw_in_av(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+          IF ( .NOT. ALLOCATED ( rad_lw_out_av ) )  THEN
+             ALLOCATE ( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          rad_sw_in  = 0.0_wp
+          rad_sw_out = 0.0_wp
+          rad_lw_in  = 0.0_wp
+          rad_lw_out = 0.0_wp
+
+!
+!--       Overwrite albedo if manually set in parameter file
+          IF ( albedo_type /= 0 .AND. albedo == 9999999.9_wp )  THEN
+             albedo = albedo_pars(2,albedo_type)
+          ENDIF
+    
+          alpha = albedo
+  
+!
+!--    Initialization actions for RRTMG
+       ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
+#if defined ( __rrtmg )
+!
+!--       Allocate albedos
+          ALLOCATE ( rrtm_aldif(0:0,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rrtm_aldir(0:0,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rrtm_asdif(0:0,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rrtm_asdir(0:0,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( aldif(nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( aldir(nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( asdif(nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( asdir(nysg:nyng,nxlg:nxrg) )
+
+          IF ( albedo_type /= 0 )  THEN
+             IF ( albedo_lw_dif == 9999999.9_wp )  THEN
+                albedo_lw_dif = albedo_pars(0,albedo_type)
+                albedo_lw_dir = albedo_lw_dif
+             ENDIF
+             IF ( albedo_sw_dif == 9999999.9_wp )  THEN
+                albedo_sw_dif = albedo_pars(1,albedo_type)
+                albedo_sw_dir = albedo_sw_dif
+             ENDIF
+          ENDIF
+
+          aldif(:,:) = albedo_lw_dif
+          aldir(:,:) = albedo_lw_dir
+          asdif(:,:) = albedo_sw_dif
+          asdir(:,:) = albedo_sw_dir
+!
+!--       Calculate initial values of current (cosine of) the zenith angle and 
+!--       whether the sun is up
+          CALL calc_zenith     
+!
+!--       Calculate initial surface albedo
+          IF ( .NOT. constant_albedo )  THEN
+             CALL calc_albedo
+          ELSE
+             rrtm_aldif(0,:,:) = aldif(:,:)
+             rrtm_aldir(0,:,:) = aldir(:,:)
+             rrtm_asdif(0,:,:) = asdif(:,:) 
+             rrtm_asdir(0,:,:) = asdir(:,:)   
+          ENDIF
+
+!
+!--       Allocate surface emissivity
+          ALLOCATE ( rrtm_emis(0:0,1:nbndlw+1) )
+          rrtm_emis = emissivity
+
+!
+!--       Allocate 3d arrays of radiative fluxes and heating rates
+          ALLOCATE ( rad_sw_hr(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rad_sw_cs_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rad_sw_cs_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rad_sw_cs_hr(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
+
+          IF ( .NOT. ALLOCATED ( rad_sw_in ) )  THEN
+             ALLOCATE ( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+             rad_sw_in = 0.0_wp
+
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_sw_in_av ) )  THEN
+             ALLOCATE ( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+             rad_sw_out = 0.0_wp
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_sw_out ) )  THEN
+             ALLOCATE ( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_sw_out_av ) )  THEN
+             ALLOCATE ( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          ALLOCATE ( rad_lw_hr(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rad_lw_cs_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rad_lw_cs_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE ( rad_lw_cs_hr(nzb+1:nzt+1,nysg:nyng,nxlg:nxrg) )
+
+          IF ( .NOT. ALLOCATED ( rad_lw_in ) )  THEN
+             ALLOCATE ( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+             rad_lw_in     = 0.0_wp
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_lw_in_av ) )  THEN
+             ALLOCATE ( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
+             ALLOCATE ( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+            rad_lw_out    = 0.0_wp
+          ENDIF
+
+          IF ( .NOT. ALLOCATED ( rad_lw_out_av ) )  THEN
+             ALLOCATE ( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ENDIF
+
+          rad_sw_hr     = 0.0_wp
+          rad_sw_cs_in  = 0.0_wp
+          rad_sw_cs_out = 0.0_wp
+          rad_sw_cs_hr  = 0.0_wp
+
+          rad_lw_hr     = 0.0_wp
+          rad_lw_cs_in  = 0.0_wp
+          rad_lw_cs_out = 0.0_wp
+          rad_lw_cs_hr  = 0.0_wp
+
+!
+!--       Allocate dummy array for storing surface temperature
+          ALLOCATE ( rrtm_tsfc(1) )
+
+!
+!--       Initialize RRTMG
+          IF ( lw_radiation )  CALL rrtmg_lw_ini ( cp )
+          IF ( sw_radiation )  CALL rrtmg_sw_ini ( cp )
+
+!
+!--       Set input files for RRTMG
+          INQUIRE(FILE="RAD_SND_DATA", EXIST=snd_exists) 
+          IF ( .NOT. snd_exists )  THEN
+             rrtm_input_file = "rrtmg_lw.nc"
+          ENDIF
+
+!
+!--       Read vertical layers for RRTMG from sounding data
+!--       The routine provides nzt_rad, hyp_snd(1:nzt_rad),
+!--       t_snd(nzt+2:nzt_rad), rrtm_play(1:nzt_rad), rrtm_plev(1_nzt_rad+1), 
+!--       rrtm_tlay(nzt+2:nzt_rad), rrtm_tlev(nzt+2:nzt_rad+1)
+          CALL read_sounding_data
+
+!
+!--       Read trace gas profiles from file. This routine provides
+!--       the rrtm_ arrays (1:nzt_rad+1)
+          CALL read_trace_gas_data
+#endif
+       ENDIF
+
+!
+!--    Perform user actions if required
+       CALL user_init_radiation
+
+
 !
 !--    Add timeseries for radiation model
+       dots_rad = dots_num + 1
        dots_label(dots_num+1) = "rad_net"
-       dots_label(dots_num+2) = "rad_sw_in"
-       dots_unit(dots_num+1:dots_num+2) = "W/m2"
-
-       dots_rad  = dots_num + 1
-       dots_num  = dots_num + 2
+       dots_label(dots_num+2) = "rad_lw_in"
+       dots_label(dots_num+3) = "rad_lw_out"
+       dots_label(dots_num+4) = "rad_sw_in"
+       dots_label(dots_num+5) = "rad_sw_out"
+       dots_unit(dots_num+1:dots_num+5) = "W/m2"
+       dots_num  = dots_num + 5
+
+!
+!--    Output of albedos is only required for RRTMG
+       IF ( radiation_scheme == 'rrtmg' )  THEN
+          dots_label(dots_num+1) = "rrtm_aldif"
+          dots_label(dots_num+2) = "rrtm_aldir"
+          dots_label(dots_num+3) = "rrtm_asdif"
+          dots_label(dots_num+4) = "rrtm_asdir"
+          dots_unit(dots_num+1:dots_num+4) = ""
+          dots_num  = dots_num + 4
+       ENDIF
+
+!
+!--    Calculate radiative fluxes at model start
+       IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
+          IF ( radiation_scheme == 'clear-sky' )  THEN
+              CALL radiation_clearsky
+          ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
+             CALL radiation_rrtmg
+          ENDIF
+       ENDIF
 
        RETURN
@@ -196,13 +599,267 @@
 !------------------------------------------------------------------------------!
     SUBROUTINE radiation_clearsky
-    
+
+       USE indices,                                                            &
+           ONLY:  nbgp
 
        IMPLICIT NONE
 
+       INTEGER(iwp) :: i, j, k
+
+!
+!--    Calculate current zenith angle
+       CALL calc_zenith
+
+!
+!--    Calculate sky transmissivity
+       sky_trans = 0.6_wp + 0.2_wp * zenith(0)
+
+!
+!--    Calculate value of the Exner function
+       exn = (surface_pressure / 1000.0_wp )**0.286_wp
+!
+!--    Calculate radiation fluxes and net radiation (rad_net) for each grid 
+!--    point
+       DO i = nxl, nxr
+          DO j = nys, nyn
+             k = nzb_s_inner(j,i)
+             rad_sw_in(0,j,i)  = solar_constant * sky_trans * zenith(0)
+             rad_sw_out(0,j,i) = alpha(j,i) * rad_sw_in(0,j,i)
+             rad_lw_out(0,j,i) = sigma_sb * (pt(k,j,i) * exn)**4
+             rad_lw_in(0,j,i)  = 0.8_wp * sigma_sb * (pt(k+1,j,i) * exn)**4
+             rad_net(j,i)      = rad_sw_in(0,j,i) - rad_sw_out(0,j,i)          &
+                                 + rad_lw_in(0,j,i) - rad_lw_out(0,j,i)
+
+          ENDDO
+       ENDDO
+
+       CALL exchange_horiz_2d( rad_lw_in,  nbgp )
+       CALL exchange_horiz_2d( rad_lw_out, nbgp )
+       CALL exchange_horiz_2d( rad_sw_in,  nbgp )
+       CALL exchange_horiz_2d( rad_sw_out, nbgp )
+       CALL exchange_horiz_2d( rad_net,    nbgp )
+
+       RETURN
+
+    END SUBROUTINE radiation_clearsky
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!-- Implementation of the RRTMG radiation_scheme
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_rrtmg
+
+       USE indices,                                                            &
+           ONLY:  nbgp
+
+       USE particle_attributes,                                                &
+           ONLY:  grid_particles, number_of_particles, particles,              &
+                  particle_advection_start, prt_count
+
+       IMPLICIT NONE
+
+#if defined ( __rrtmg )
+
+       INTEGER(iwp) :: i, j, k, n          !: 
+
+       REAL(wp)     ::  s_r2      !: weighted sum over all droplets with r^2
+       REAL(wp)     ::  s_r3      !: weighted sum over all droplets with r^3
+
+!
+!--    Calculate current (cosine of) zenith angle and whether the sun is up
+       CALL calc_zenith     
+!
+!--    Calculate surface albedo
+       IF ( .NOT. constant_albedo )  THEN
+          CALL calc_albedo
+       ENDIF
+
+!
+!--    Prepare input data for RRTMG
+
+!
+!--    In case of large scale forcing with surface data, calculate new pressure
+!--    profile. nzt_rad might be modified by these calls and all required arrays
+!--    will then be re-allocated
+       IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
+          CALL read_sounding_data
+          CALL read_trace_gas_data
+       ENDIF
+!
+!--    Loop over all grid points
+       DO i = nxl, nxr
+          DO j = nys, nyn
+
+!
+!--          Prepare profiles of temperature and H2O volume mixing ratio
+             rrtm_tlev(0,nzb+1) = pt(nzb,j,i)
+
+             DO k = nzb+1, nzt+1
+                rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp         &
+                                 )**0.286_wp + ( l_v / cp ) * ql(k,j,i)
+                rrtm_h2ovmr(0,k) = mol_weight_air_d_wv * (q(k,j,i) - ql(k,j,i))
+
+             ENDDO
+
+!
+!--          Avoid temperature/humidity jumps at the top of the LES domain by 
+!--          linear interpolation from nzt+2 to nzt+7
+             DO k = nzt+2, nzt+7
+                rrtm_tlay(0,k) = rrtm_tlay(0,nzt+1)                            &
+                              + ( rrtm_tlay(0,nzt+8) - rrtm_tlay(0,nzt+1) )    &
+                              / ( rrtm_play(0,nzt+8) - rrtm_play(0,nzt+1) )    &
+                              * ( rrtm_play(0,k) - rrtm_play(0,nzt+1) )
+
+                rrtm_h2ovmr(0,k) = rrtm_h2ovmr(0,nzt+1)                        &
+                              + ( rrtm_h2ovmr(0,nzt+8) - rrtm_h2ovmr(0,nzt+1) )&
+                              / ( rrtm_play(0,nzt+8)   - rrtm_play(0,nzt+1)   )&
+                              * ( rrtm_play(0,k) - rrtm_play(0,nzt+1) )
+
+             ENDDO
+
+!--          Linear interpolate to zw grid
+             DO k = nzb+2, nzt+8
+                rrtm_tlev(0,k)   = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k) -        &
+                                   rrtm_tlay(0,k-1))                           &
+                                   / ( rrtm_play(0,k) - rrtm_play(0,k-1) )     &
+                                   * ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
+             ENDDO
+
+
+!
+!--          Calculate liquid water path and cloud fraction for each column.
+!--          Note that LWP is required in g/mÂ² instead of kg/kg m.
+             rrtm_cldfr  = 0.0_wp
+             rrtm_reliq  = 0.0_wp
+             rrtm_cliqwp = 0.0_wp
+
+             DO k = nzb+1, nzt+1
+                rrtm_cliqwp(0,k) =  ql(k,j,i) * 1000.0_wp *                      &
+                                  (rrtm_plev(0,k) - rrtm_plev(0,k+1)) * 100.0_wp / g 
+
+                IF ( rrtm_cliqwp(0,k) .GT. 0 )  THEN
+                   rrtm_cldfr(0,k) = 1.0_wp
+                   rrtm_icld = 1
+
+!
+!--                Calculate cloud droplet effective radius
+                   IF ( cloud_physics )  THEN
+                      rrtm_reliq(0,k) = 1.0E6_wp * ( 3.0_wp * ql(k,j,i)          &
+                                      / ( 4.0_wp * pi * nc_const * rho_l )     &
+                                      )**0.33333333333333_wp                   &
+                                     * EXP( LOG( sigma_gc )**2 )
+
+                   ELSEIF ( cloud_droplets )  THEN
+                      number_of_particles = prt_count(k,j,i)
+
+                      IF (number_of_particles <= 0)  CYCLE
+                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+                      s_r2 = 0.0_wp
+                      s_r3 = 0.0_wp
+
+                      DO  n = 1, number_of_particles
+                         IF ( particles(n)%particle_mask )  THEN
+                            s_r2 = s_r2 + particles(n)%radius**2 * &
+                                   particles(n)%weight_factor
+                            s_r3 = s_r3 + particles(n)%radius**3 * &
+                                   particles(n)%weight_factor
+                         ENDIF
+                      ENDDO
+
+                      IF ( s_r2 > 0.0_wp )  rrtm_reliq(0,k) = s_r3 / s_r2
+
+                   ENDIF
+
+!
+!--                Limit effective radius
+                   IF ( rrtm_reliq(0,k) .GT. 0.0_wp )  THEN
+                      rrtm_reliq(0,k) = MAX(rrtm_reliq(0,k),2.5_wp)
+                      rrtm_reliq(0,k) = MIN(rrtm_reliq(0,k),60.0_wp)
+                  ENDIF
+                ELSE
+                   rrtm_icld = 0
+                ENDIF
+             ENDDO
+
+!
+!--          Set surface temperature
+             rrtm_tsfc = pt(nzb,j,i) * (surface_pressure / 1000.0_wp )**0.286_wp
+
+             IF ( lw_radiation )  THEN
+               CALL rrtmg_lw( 1, nzt_rad      , rrtm_icld    , rrtm_idrv      ,&
+               rrtm_play       , rrtm_plev    , rrtm_tlay    , rrtm_tlev      ,&
+               rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr   , rrtm_co2vmr    ,&
+               rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr   , rrtm_cfc11vmr  ,&
+               rrtm_cfc12vmr   , rrtm_cfc22vmr, rrtm_ccl4vmr , rrtm_emis      ,&
+               rrtm_inflglw    , rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr     ,&
+               rrtm_lw_taucld  , rrtm_cicewp  , rrtm_cliqwp  , rrtm_reice     ,& 
+               rrtm_reliq      , rrtm_lw_tauaer,                               &
+               rrtm_lwuflx     , rrtm_lwdflx  , rrtm_lwhr  ,                   &
+               rrtm_lwuflxc    , rrtm_lwdflxc , rrtm_lwhrc )
+
+                DO k = nzb, nzt+1
+                   rad_lw_in(k,j,i)  = rrtm_lwdflx(0,k)
+                   rad_lw_out(k,j,i) = rrtm_lwuflx(0,k)
+                ENDDO
+
+
+             ENDIF
+
+             IF ( sw_radiation .AND. sun_up )  THEN
+                CALL rrtmg_sw( 1, nzt_rad      , rrtm_icld  , rrtm_iaer       ,&
+               rrtm_play       , rrtm_plev    , rrtm_tlay  , rrtm_tlev        ,&
+               rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr , rrtm_co2vmr      ,&
+               rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr , rrtm_asdir(:,j,i),&
+               rrtm_asdif(:,j,i), rrtm_aldir(:,j,i), rrtm_aldif(:,j,i), zenith,&
+               0.0_wp          , day          , solar_constant,   rrtm_inflgsw,&
+               rrtm_iceflgsw   , rrtm_liqflgsw, rrtm_cldfr , rrtm_sw_taucld   ,&
+               rrtm_sw_ssacld  , rrtm_sw_asmcld, rrtm_sw_fsfcld, rrtm_cicewp  ,&
+               rrtm_cliqwp     , rrtm_reice   , rrtm_reliq , rrtm_sw_tauaer   ,&
+               rrtm_sw_ssaaer     , rrtm_sw_asmaer  , rrtm_sw_ecaer ,          &
+               rrtm_swuflx     , rrtm_swdflx  , rrtm_swhr  ,                   &
+               rrtm_swuflxc    , rrtm_swdflxc , rrtm_swhrc )
+  
+                DO k = nzb, nzt+1
+                   rad_sw_in(k,j,i)  = rrtm_swdflx(0,k)
+                   rad_sw_out(k,j,i) = rrtm_swuflx(0,k)
+                ENDDO
+             ENDIF
+
+!
+!--          Calculate surface net radiation
+             rad_net(j,i) = rad_sw_in(nzb,j,i) - rad_sw_out(nzb,j,i)           &
+                            + rad_lw_in(nzb,j,i) - rad_lw_out(nzb,j,i)
+
+          ENDDO
+       ENDDO
+
+       CALL exchange_horiz( rad_lw_in,  nbgp )
+       CALL exchange_horiz( rad_lw_out, nbgp )
+       CALL exchange_horiz( rad_sw_in,  nbgp )
+       CALL exchange_horiz( rad_sw_out, nbgp ) 
+       CALL exchange_horiz_2d( rad_net, nbgp )
+#endif
+
+    END SUBROUTINE radiation_rrtmg
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!-- Calculate the cosine of the zenith angle (variable is called zenith)
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_zenith
+
+       IMPLICIT NONE
+
+       REAL(wp) ::  declination,  & !: solar declination angle
+                    hour_angle      !: solar hour angle
 !
 !--    Calculate current day and time based on the initial values and simulation
 !--    time
-       day = day_init + FLOOR( (time_utc_init + time_since_reference_point)    &
-                               / 86400.0_wp )
+       day = day_init + INT(FLOOR( (time_utc_init + time_since_reference_point)    &
+                               / 86400.0_wp ), KIND=iwp)
        time_utc = MOD((time_utc_init + time_since_reference_point), 86400.0_wp)
 
@@ -210,62 +867,720 @@
 !
 !--    Calculate solar declination and hour angle   
-       declination = ASIN( decl_1 * SIN(decl_2 * day - decl_3) )
+       declination = ASIN( decl_1 * SIN(decl_2 * REAL(day, KIND=wp) - decl_3) )
        hour_angle  = 2.0_wp * pi * (time_utc / 86400.0_wp) + lon - pi
 
 !
 !--    Calculate zenith angle
-       zenith = SIN(lat) * SIN(declination) + COS(lat) * COS(declination)       &
+       zenith(0) = SIN(lat) * SIN(declination) + COS(lat) * COS(declination)      &
                                             * COS(hour_angle)
-       zenith = MAX(0.0_wp,zenith)
-
-!
-!--    Calculate sky transmissivity
-       sky_trans = 0.6_wp + 0.2_wp * zenith
-
-!
-!--    Calculate value of the Exner function
-       exn = (surface_pressure / 1000.0_wp )**0.286_wp
-
-!
-!--    Calculate radiation fluxes and net radiation (rad_net) for each grid 
-!--    point
-       DO i = nxlg, nxrg
-          DO j = nysg, nyng
-
-             k = nzb_s_inner(j,i)
-             rad_sw_in(j,i)  = sw_0 * sky_trans * zenith
-             rad_sw_out(j,i) = - alpha(j,i) * rad_sw_in(j,i)
-             rad_lw_out(j,i) = - sigma_sb * (pt(k,j,i) * exn)**4
-             rad_lw_in(j,i)  = 0.8_wp * sigma_sb * (pt(k+1,j,i) * exn)**4
-             rad_net(j,i)    = rad_sw_in(j,i) + rad_sw_out(j,i)                &
-                                + rad_lw_in(j,i) + rad_lw_out(j,i)
-
+       zenith(0) = MAX(0.0_wp,zenith(0))
+
+!
+!--    Check if the sun is up (otheriwse shortwave calculations can be skipped)
+       IF ( zenith(0) .GT. 0.0_wp )  THEN
+          sun_up = .TRUE.
+       ELSE
+          sun_up = .FALSE.
+       END IF
+
+    END SUBROUTINE calc_zenith
+
+#if defined ( __rrtmg )
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!-- Calculates surface albedo components based on Briegleb (1992) and 
+!-- Briegleb et al. (1986)
+!------------------------------------------------------------------------------!
+    SUBROUTINE calc_albedo
+
+        IMPLICIT NONE
+
+        IF ( sun_up )  THEN
+!
+!--        Ocean
+           IF ( albedo_type == 1 )  THEN
+              rrtm_aldir(0,:,:) = 0.026_wp / ( zenith(0)**1.7_wp + 0.065_wp )  &
+                                  + 0.15_wp * ( zenith(0) - 0.1_wp )           &
+                                            * ( zenith(0) - 0.5_wp )           &
+                                            * ( zenith(0) - 1.0_wp )
+              rrtm_asdir(0,:,:) = rrtm_aldir(0,:,:)
+!
+!--        Snow
+           ELSEIF ( albedo_type == 16 )  THEN
+              IF ( zenith(0) < 0.5_wp )  THEN
+                 rrtm_aldir(0,:,:) = 0.5_wp * (1.0_wp - aldif)                 &
+                                     * ( 3.0_wp / (1.0_wp + 4.0_wp             &
+                                     * zenith(0))) - 1.0_wp
+                 rrtm_asdir(0,:,:) = 0.5_wp * (1.0_wp - asdif)                 &
+                                     * ( 3.0_wp / (1.0_wp + 4.0_wp             &
+                                     * zenith(0))) - 1.0_wp
+
+                 rrtm_aldir(0,:,:) = MIN(0.98_wp, rrtm_aldir(0,:,:))
+                 rrtm_asdir(0,:,:) = MIN(0.98_wp, rrtm_asdir(0,:,:))
+              ELSE
+                 rrtm_aldir(0,:,:) = aldif
+                 rrtm_asdir(0,:,:) = asdif
+              ENDIF
+!
+!--        Sea ice
+           ELSEIF ( albedo_type == 15 )  THEN
+                 rrtm_aldir(0,:,:) = aldif
+                 rrtm_asdir(0,:,:) = asdif
+!
+!--        Land surfaces
+           ELSE
+              SELECT CASE ( albedo_type )
+
+!
+!--              Surface types with strong zenith dependence
+                 CASE ( 1, 2, 3, 4, 11, 12, 13 )
+                    rrtm_aldir(0,:,:) = aldif * 1.4_wp /                       &
+                                        (1.0_wp + 0.8_wp * zenith(0))
+                    rrtm_asdir(0,:,:) = asdif * 1.4_wp /                       &
+                                        (1.0_wp + 0.8_wp * zenith(0))
+!
+!--              Surface types with weak zenith dependence
+                 CASE ( 5, 6, 7, 8, 9, 10, 14 )
+                    rrtm_aldir(0,:,:) = aldif * 1.1_wp /                       &
+                                        (1.0_wp + 0.2_wp * zenith(0))
+                    rrtm_asdir(0,:,:) = asdif * 1.1_wp /                       &
+                                        (1.0_wp + 0.2_wp * zenith(0))
+
+                 CASE DEFAULT
+
+              END SELECT
+           ENDIF
+!
+!--        Diffusive albedo is taken from Table 2
+           rrtm_aldif(0,:,:) = aldif
+           rrtm_asdif(0,:,:) = asdif
+
+        ELSE
+
+           rrtm_aldir(0,:,:) = 0.0_wp
+           rrtm_asdir(0,:,:) = 0.0_wp
+           rrtm_aldif(0,:,:) = 0.0_wp
+           rrtm_asdif(0,:,:) = 0.0_wp
+        ENDIF
+    END SUBROUTINE calc_albedo
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!-- Read sounding data (pressure and temperature) from RADIATION_DATA.
+!------------------------------------------------------------------------------!
+    SUBROUTINE read_sounding_data
+
+       USE netcdf_control
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: id, id_dim_zrad, id_var, k, nz_snd, nz_snd_start, nz_snd_end
+
+       REAL(wp) :: t_surface
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  hyp_snd_tmp, t_snd_tmp
+
+!
+!--    In case of updates, deallocate arrays first (sufficient to check one
+!--    array as the others are automatically allocated). This is required
+!--    because nzt_rad might change during the update
+       IF ( ALLOCATED ( hyp_snd ) )  THEN
+          DEALLOCATE( hyp_snd )
+          DEALLOCATE( t_snd )
+          DEALLOCATE( q_snd  )
+          DEALLOCATE ( rrtm_play )
+          DEALLOCATE ( rrtm_plev )
+          DEALLOCATE ( rrtm_tlay )
+          DEALLOCATE ( rrtm_tlev )
+          DEALLOCATE ( rrtm_h2ovmr )
+          DEALLOCATE ( rrtm_cicewp )
+          DEALLOCATE ( rrtm_cldfr )
+          DEALLOCATE ( rrtm_cliqwp )
+          DEALLOCATE ( rrtm_reice )
+          DEALLOCATE ( rrtm_reliq )
+          DEALLOCATE ( rrtm_lw_taucld )
+          DEALLOCATE ( rrtm_lw_tauaer )
+          DEALLOCATE ( rrtm_lwdflx  )
+          DEALLOCATE ( rrtm_lwuflx  )
+          DEALLOCATE ( rrtm_lwhr  )
+          DEALLOCATE ( rrtm_lwuflxc )
+          DEALLOCATE ( rrtm_lwdflxc )
+          DEALLOCATE ( rrtm_lwhrc )
+          DEALLOCATE ( rrtm_sw_taucld )
+          DEALLOCATE ( rrtm_sw_ssacld )
+          DEALLOCATE ( rrtm_sw_asmcld )
+          DEALLOCATE ( rrtm_sw_fsfcld )
+          DEALLOCATE ( rrtm_sw_tauaer )
+          DEALLOCATE ( rrtm_sw_ssaaer )
+          DEALLOCATE ( rrtm_sw_asmaer ) 
+          DEALLOCATE ( rrtm_sw_ecaer )    
+          DEALLOCATE ( rrtm_swdflx  )
+          DEALLOCATE ( rrtm_swuflx  )
+          DEALLOCATE ( rrtm_swhr  )
+          DEALLOCATE ( rrtm_swuflxc )
+          DEALLOCATE ( rrtm_swdflxc )
+          DEALLOCATE ( rrtm_swhrc )
+       ENDIF
+
+!
+!--    Open file for reading
+       nc_stat = NF90_OPEN( rrtm_input_file, NF90_NOWRITE, id )
+       CALL handle_netcdf_error( 'netcdf', 549 )
+
+!
+!--    Inquire dimension of z axis and save in nz_snd
+       nc_stat = NF90_INQ_DIMID( id, "Pressure", id_dim_zrad )
+       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim_zrad, len = nz_snd )
+       CALL handle_netcdf_error( 'netcdf', 551 )
+
+!
+! !--    Allocate temporary array for storing pressure data
+       ALLOCATE( hyp_snd_tmp(nzb+1:nz_snd) )
+       hyp_snd_tmp = 0.0_wp
+
+
+!--    Read pressure from file
+       nc_stat = NF90_INQ_VARID( id, "Pressure", id_var )
+       nc_stat = NF90_GET_VAR( id, id_var, hyp_snd_tmp(:), start = (/1/),    &
+                               count = (/nz_snd/) )
+       CALL handle_netcdf_error( 'netcdf', 552 )
+
+!
+!--    Allocate temporary array for storing temperature data
+       ALLOCATE( t_snd_tmp(nzb+1:nz_snd) )
+       t_snd_tmp = 0.0_wp
+
+!
+!--    Read temperature from file
+       nc_stat = NF90_INQ_VARID( id, "ReferenceTemperature", id_var )
+       nc_stat = NF90_GET_VAR( id, id_var, t_snd_tmp(:), start = (/1/),      &
+                               count = (/nz_snd/) )
+       CALL handle_netcdf_error( 'netcdf', 553 )
+
+!
+!--    Calculate start of sounding data
+       nz_snd_start = nz_snd + 1
+       nz_snd_end   = nz_snd_end
+
+!
+!--    Start filling vertical dimension at 10hPa above the model domain (hyp is
+!--    in Pa, hyp_snd in hPa).
+       DO  k = 1, nz_snd
+          IF ( hyp_snd_tmp(k) .LT. (hyp(nzt+1) - 1000.0_wp) * 0.01_wp )  THEN
+             nz_snd_start = k
+             EXIT
+          END IF
+       END DO
+
+       IF ( nz_snd_start .LE. nz_snd )  THEN
+          nz_snd_end = nz_snd - 1
+       END IF
+
+
+!
+!--    Calculate of total grid points for RRTMG calculations
+       nzt_rad = nzt + nz_snd_end - nz_snd_start + 2
+
+!
+!--    Save data above LES domain in hyp_snd, t_snd and q_snd
+!--    Note: q_snd_tmp is not calculated at the moment (dry residual atmosphere)
+       ALLOCATE( hyp_snd(nzb+1:nzt_rad) )
+       ALLOCATE( t_snd(nzb+1:nzt_rad)   )
+       ALLOCATE( q_snd(nzb+1:nzt_rad)   )
+       hyp_snd = 0.0_wp
+       t_snd = 0.0_wp
+       q_snd = 0.0_wp
+
+       hyp_snd(nzt+2:nzt_rad) = hyp_snd_tmp(nz_snd_start:nz_snd_end)
+       t_snd(nzt+2:nzt_rad)   = t_snd_tmp(nz_snd_start:nz_snd_end)
+
+       DEALLOCATE ( hyp_snd_tmp )
+       DEALLOCATE ( t_snd_tmp )
+
+       nc_stat = NF90_CLOSE( id )
+
+!
+!--    Calculate pressure levels on zu and zw grid. Sounding data is added at 
+!--    top of the LES domain. This routine does not consider horizontal or 
+!--    vertical variability of pressure and temperature
+       ALLOCATE ( rrtm_play(0:0,nzb+1:nzt_rad+1)   )
+       ALLOCATE ( rrtm_plev(0:0,nzb+1:nzt_rad+2)   )
+
+       t_surface = pt_surface * (surface_pressure / 1000.0_wp )**0.286_wp
+       DO k = nzb+1, nzt+1
+          rrtm_play(0,k) = hyp(k) * 0.01_wp
+          rrtm_plev(0,k) = surface_pressure * ( (t_surface - g/cp * zw(k-1)) / &
+                         t_surface )**(1.0_wp/0.286_wp)
+       ENDDO
+
+       DO k = nzt+2, nzt_rad
+          rrtm_play(0,k) = hyp_snd(k)
+          rrtm_plev(0,k) = 0.5_wp * ( rrtm_play(0,k) + rrtm_play(0,k-1) )
+       ENDDO
+       rrtm_plev(0,nzt_rad+1) = MAX( 0.5 * hyp_snd(nzt_rad),                   &
+                                   1.5 * hyp_snd(nzt_rad)                      &
+                                 - 0.5 * hyp_snd(nzt_rad-1) )
+       rrtm_plev(0,nzt_rad+2)  = MIN( 1.0E-4_wp,                               &
+                                      0.25_wp * rrtm_plev(0,nzt_rad+1) )
+
+       rrtm_play(0,nzt_rad+1) = 0.5 * rrtm_plev(0,nzt_rad+1)
+
+!
+!--    Calculate temperature/humidity levels at top of the LES domain. 
+!--    Currently, the temperature is taken from sounding data (might lead to a 
+!--    temperature jump at interface. To do: Humidity is currently not 
+!--    calculated above the LES domain.
+       ALLOCATE ( rrtm_tlay(0:0,nzb+1:nzt_rad+1)   )
+       ALLOCATE ( rrtm_tlev(0:0,nzb+1:nzt_rad+2)   )
+       ALLOCATE ( rrtm_h2ovmr(0:0,nzb+1:nzt_rad+1) )
+
+       DO k = nzt+8, nzt_rad
+          rrtm_tlay(0,k)   = t_snd(k)
+          rrtm_h2ovmr(0,k) = q_snd(k)
+       ENDDO
+       rrtm_tlay(0,nzt_rad+1)   = 2.0_wp * rrtm_tlay(0,nzt_rad)                &
+                                  - rrtm_tlay(0,nzt_rad-1)
+       DO k = nzt+9, nzt_rad+1
+          rrtm_tlev(0,k)   = rrtm_tlay(0,k-1) + (rrtm_tlay(0,k)                &
+                             - rrtm_tlay(0,k-1))                               &
+                             / ( rrtm_play(0,k) - rrtm_play(0,k-1) )           &
+                             * ( rrtm_plev(0,k) - rrtm_play(0,k-1) )
+       ENDDO
+       rrtm_h2ovmr(0,nzt_rad+1) = rrtm_h2ovmr(0,nzt_rad)
+
+       rrtm_tlev(0,nzt_rad+2)   = 2.0_wp * rrtm_tlay(0,nzt_rad+1)              &
+                                  - rrtm_tlev(0,nzt_rad)
+!
+!--    Allocate remaining RRTMG arrays
+       ALLOCATE ( rrtm_cicewp(0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_cldfr(0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_cliqwp(0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_reice(0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_reliq(0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_lw_taucld(1:nbndlw+1,0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_lw_tauaer(0:0,nzb+1:nzt_rad+1,1:nbndlw+1) )
+       ALLOCATE ( rrtm_sw_taucld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_sw_ssacld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_sw_asmcld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_sw_fsfcld(1:nbndsw+1,0:0,nzb+1:nzt_rad+1) )
+       ALLOCATE ( rrtm_sw_tauaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
+       ALLOCATE ( rrtm_sw_ssaaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) )
+       ALLOCATE ( rrtm_sw_asmaer(0:0,nzb+1:nzt_rad+1,1:nbndsw+1) ) 
+       ALLOCATE ( rrtm_sw_ecaer(0:0,nzb+1:nzt_rad+1,1:naerec+1) )    
+
+!
+!--    The ice phase is currently not considered in PALM
+       rrtm_cicewp = 0.0_wp
+       rrtm_reice  = 0.0_wp
+
+!
+!--    Set other parameters (move to NAMELIST parameters in the future)
+       rrtm_lw_tauaer = 0.0_wp
+       rrtm_lw_taucld = 0.0_wp
+       rrtm_sw_taucld = 0.0_wp
+       rrtm_sw_ssacld = 0.0_wp
+       rrtm_sw_asmcld = 0.0_wp
+       rrtm_sw_fsfcld = 0.0_wp
+       rrtm_sw_tauaer = 0.0_wp
+       rrtm_sw_ssaaer = 0.0_wp
+       rrtm_sw_asmaer = 0.0_wp
+       rrtm_sw_ecaer  = 0.0_wp
+
+
+       ALLOCATE ( rrtm_swdflx(0:0,nzb:nzt_rad+1)  )
+       ALLOCATE ( rrtm_swuflx(0:0,nzb:nzt_rad+1)  )
+       ALLOCATE ( rrtm_swhr(0:0,nzb+1:nzt_rad+1)  )
+       ALLOCATE ( rrtm_swuflxc(0:0,nzb:nzt_rad+1) )
+       ALLOCATE ( rrtm_swdflxc(0:0,nzb:nzt_rad+1) )
+       ALLOCATE ( rrtm_swhrc(0:0,nzb+1:nzt_rad+1) )
+
+       rrtm_swdflx  = 0.0_wp
+       rrtm_swuflx  = 0.0_wp
+       rrtm_swhr    = 0.0_wp  
+       rrtm_swuflxc = 0.0_wp
+       rrtm_swdflxc = 0.0_wp
+       rrtm_swhrc   = 0.0_wp
+
+       ALLOCATE ( rrtm_lwdflx(0:0,nzb:nzt_rad+1)  )
+       ALLOCATE ( rrtm_lwuflx(0:0,nzb:nzt_rad+1)  )
+       ALLOCATE ( rrtm_lwhr(0:0,nzb+1:nzt_rad+1)  )
+       ALLOCATE ( rrtm_lwuflxc(0:0,nzb:nzt_rad+1) )
+       ALLOCATE ( rrtm_lwdflxc(0:0,nzb:nzt_rad+1) )
+       ALLOCATE ( rrtm_lwhrc(0:0,nzb+1:nzt_rad+1) )
+
+       rrtm_lwdflx  = 0.0_wp
+       rrtm_lwuflx  = 0.0_wp
+       rrtm_lwhr    = 0.0_wp  
+       rrtm_lwuflxc = 0.0_wp
+       rrtm_lwdflxc = 0.0_wp
+       rrtm_lwhrc   = 0.0_wp
+
+
+    END SUBROUTINE read_sounding_data
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!-- Read trace gas data from file
+!------------------------------------------------------------------------------!
+    SUBROUTINE read_trace_gas_data
+
+       USE netcdf_control
+       USE rrsw_ncpar
+
+       IMPLICIT NONE
+
+       INTEGER(iwp), PARAMETER :: num_trace_gases = 9 !: number of trace gases
+
+       CHARACTER(LEN=5), DIMENSION(num_trace_gases), PARAMETER ::              &
+           trace_names = (/'O3   ', 'CO2  ', 'CH4  ', 'N2O  ', 'O2   ',        &
+                           'CFC11', 'CFC12', 'CFC22', 'CCL4 '/)
+
+       INTEGER(iwp) :: id, k, m, n, nabs, np, id_abs, id_dim, id_var
+
+       REAL(wp) :: p_mls_l, p_mls_u, p_wgt_l, p_wgt_u, p_mls_m
+
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  p_mls,         & !: pressure levels for the absorbers
+                                                 rrtm_play_tmp, & !: temporary array for pressure zu-levels
+                                                 rrtm_plev_tmp, & !: temporary array for pressure zw-levels
+                                                 trace_path_tmp   !: temporary array for storing trace gas path data
+
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  trace_mls,      & !: array for storing the absorber amounts
+                                                 trace_mls_path, & !: array for storing trace gas path data
+                                                 trace_mls_tmp     !: temporary array for storing trace gas data
+
+
+!
+!--    In case of updates, deallocate arrays first (sufficient to check one
+!--    array as the others are automatically allocated)
+       IF ( ALLOCATED ( rrtm_o3vmr ) )  THEN
+          DEALLOCATE ( rrtm_o3vmr  )
+          DEALLOCATE ( rrtm_co2vmr )
+          DEALLOCATE ( rrtm_ch4vmr )
+          DEALLOCATE ( rrtm_n2ovmr )
+          DEALLOCATE ( rrtm_o2vmr  )
+          DEALLOCATE ( rrtm_cfc11vmr )
+          DEALLOCATE ( rrtm_cfc12vmr )
+          DEALLOCATE ( rrtm_cfc22vmr )
+          DEALLOCATE ( rrtm_ccl4vmr  )
+       ENDIF
+
+!
+!--    Allocate trace gas profiles
+       ALLOCATE ( rrtm_o3vmr(0:0,1:nzt_rad+1)  )
+       ALLOCATE ( rrtm_co2vmr(0:0,1:nzt_rad+1) )
+       ALLOCATE ( rrtm_ch4vmr(0:0,1:nzt_rad+1) )
+       ALLOCATE ( rrtm_n2ovmr(0:0,1:nzt_rad+1) )
+       ALLOCATE ( rrtm_o2vmr(0:0,1:nzt_rad+1)  )
+       ALLOCATE ( rrtm_cfc11vmr(0:0,1:nzt_rad+1) )
+       ALLOCATE ( rrtm_cfc12vmr(0:0,1:nzt_rad+1) )
+       ALLOCATE ( rrtm_cfc22vmr(0:0,1:nzt_rad+1) )
+       ALLOCATE ( rrtm_ccl4vmr(0:0,1:nzt_rad+1)  )
+
+!
+!--    Open file for reading
+       nc_stat = NF90_OPEN( rrtm_input_file, NF90_NOWRITE, id )
+       CALL handle_netcdf_error( 'netcdf', 549 )
+!
+!--    Inquire dimension ids and dimensions
+       nc_stat = NF90_INQ_DIMID( id, "Pressure", id_dim )
+       CALL handle_netcdf_error( 'netcdf', 550 )
+       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, len = np) 
+       CALL handle_netcdf_error( 'netcdf', 550 )
+
+       nc_stat = NF90_INQ_DIMID( id, "Absorber", id_dim )
+       CALL handle_netcdf_error( 'netcdf', 550 )
+       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, len = nabs ) 
+       CALL handle_netcdf_error( 'netcdf', 550 )
+   
+
+!
+!--    Allocate pressure, and trace gas arrays     
+       ALLOCATE( p_mls(1:np) )
+       ALLOCATE( trace_mls(1:num_trace_gases,1:np) ) 
+       ALLOCATE( trace_mls_tmp(1:nabs,1:np) ) 
+
+
+       nc_stat = NF90_INQ_VARID( id, "Pressure", id_var )
+       CALL handle_netcdf_error( 'netcdf', 550 )
+       nc_stat = NF90_GET_VAR( id, id_var, p_mls )
+       CALL handle_netcdf_error( 'netcdf', 550 )
+
+       nc_stat = NF90_INQ_VARID( id, "AbsorberAmountMLS", id_var )
+       CALL handle_netcdf_error( 'netcdf', 550 )
+       nc_stat = NF90_GET_VAR( id, id_var, trace_mls_tmp )
+       CALL handle_netcdf_error( 'netcdf', 550 )
+
+
+!
+!--    Write absorber amounts (mls) to trace_mls
+       DO n = 1, num_trace_gases
+          CALL getAbsorberIndex( TRIM( trace_names(n) ), id_abs )
+
+          trace_mls(n,1:np) = trace_mls_tmp(id_abs,1:np)
+
+!
+!--       Replace missing values by zero
+          WHERE ( trace_mls(n,:) > 2.0_wp )  
+             trace_mls(n,:) = 0.0_wp
+          END WHERE
+       END DO
+
+       DEALLOCATE ( trace_mls_tmp )
+
+       nc_stat = NF90_CLOSE( id )
+       CALL handle_netcdf_error( 'netcdf', 551 )
+
+!
+!--    Add extra pressure level for calculations of the trace gas paths
+       ALLOCATE ( rrtm_play_tmp(1:nzt_rad+1) )
+       ALLOCATE ( rrtm_plev_tmp(1:nzt_rad+2) )
+
+       rrtm_play_tmp(1:nzt_rad)   = rrtm_play(0,1:nzt_rad) 
+       rrtm_plev_tmp(1:nzt_rad+1) = rrtm_plev(0,1:nzt_rad+1)
+       rrtm_play_tmp(nzt_rad+1)   = rrtm_plev(0,nzt_rad+1) * 0.5_wp
+       rrtm_plev_tmp(nzt_rad+2)   = MIN( 1.0E-4_wp, 0.25_wp                    &
+                                         * rrtm_plev(0,nzt_rad+1) )
+ 
+!
+!--    Calculate trace gas path (zero at surface) with interpolation to the
+!--    sounding levels
+       ALLOCATE ( trace_mls_path(1:nzt_rad+2,1:num_trace_gases) )
+
+       trace_mls_path(nzb+1,:) = 0.0_wp
+       
+       DO k = nzb+2, nzt_rad+2
+          DO m = 1, num_trace_gases
+             trace_mls_path(k,m) = trace_mls_path(k-1,m)
+
+!
+!--          When the pressure level is higher than the trace gas pressure
+!--          level, assume that 
+             IF ( rrtm_plev_tmp(k-1) .GT. p_mls(1) )  THEN             
+                
+                trace_mls_path(k,m) = trace_mls_path(k,m) + trace_mls(m,1)     &
+                                      * ( rrtm_plev_tmp(k-1)                   &
+                                          - MAX( p_mls(1), rrtm_plev_tmp(k) )  &
+                                        ) / g
+             ENDIF
+
+!
+!--          Integrate for each sounding level from the contributing p_mls 
+!--          levels
+             DO n = 2, np
+!
+!--             Limit p_mls so that it is within the model level
+                p_mls_u = MIN( rrtm_plev_tmp(k-1),                             &
+                          MAX( rrtm_plev_tmp(k), p_mls(n) ) )
+                p_mls_l = MIN( rrtm_plev_tmp(k-1),                             &
+                          MAX( rrtm_plev_tmp(k), p_mls(n-1) ) )
+
+                IF ( p_mls_l .GT. p_mls_u )  THEN
+
+!
+!--                Calculate weights for interpolation
+                   p_mls_m = 0.5_wp * (p_mls_l + p_mls_u)
+                   p_wgt_u = (p_mls(n-1) - p_mls_m) / (p_mls(n-1) - p_mls(n))
+                   p_wgt_l = (p_mls_m - p_mls(n))   / (p_mls(n-1) - p_mls(n))
+
+!
+!--                Add level to trace gas path
+                   trace_mls_path(k,m) = trace_mls_path(k,m)                   &
+                                         +  ( p_wgt_u * trace_mls(m,n)         &
+                                            + p_wgt_l * trace_mls(m,n-1) )     &
+                                         * (p_mls_l + p_mls_u) / g
+                ENDIF
+             ENDDO
+
+             IF ( rrtm_plev_tmp(k) .LT. p_mls(np) )  THEN 
+                trace_mls_path(k,m) = trace_mls_path(k,m) + trace_mls(m,np)    &
+                                      * ( MIN( rrtm_plev_tmp(k-1), p_mls(np) ) &
+                                          - rrtm_plev_tmp(k)                   &
+                                        ) / g 
+             ENDIF  
           ENDDO
        ENDDO
 
-       RETURN
-
-    END SUBROUTINE radiation_clearsky
+
+!
+!--    Prepare trace gas path profiles
+       ALLOCATE ( trace_path_tmp(1:nzt_rad+1) )
+
+       DO m = 1, num_trace_gases
+
+          trace_path_tmp(1:nzt_rad+1) = ( trace_mls_path(2:nzt_rad+2,m)        &
+                                       - trace_mls_path(1:nzt_rad+1,m) ) * g   &
+                                       / ( rrtm_plev_tmp(1:nzt_rad+1)          &
+                                       - rrtm_plev_tmp(2:nzt_rad+2) )
+
+!
+!--       Save trace gas paths to the respective arrays
+          SELECT CASE ( TRIM( trace_names(m) ) )
+
+             CASE ( 'O3' )
+
+                rrtm_o3vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'CO2' )
+
+                rrtm_co2vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'CH4' )
+
+                rrtm_ch4vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'N2O' )
+
+                rrtm_n2ovmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'O2' )
+
+                rrtm_o2vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'CFC11' )
+
+                rrtm_cfc11vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'CFC12' )
+
+                rrtm_cfc12vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'CFC22' )
+
+                rrtm_cfc22vmr(0,:) = trace_path_tmp(:)
+
+             CASE ( 'CCL4' )
+
+                rrtm_ccl4vmr(0,:) = trace_path_tmp(:)
+
+             CASE DEFAULT
+
+          END SELECT
+
+       ENDDO
+
+       DEALLOCATE ( trace_path_tmp )
+       DEALLOCATE ( trace_mls_path )
+       DEALLOCATE ( rrtm_play_tmp )
+       DEALLOCATE ( rrtm_plev_tmp )
+       DEALLOCATE ( trace_mls )
+       DEALLOCATE ( p_mls )
+
+    END SUBROUTINE read_trace_gas_data
+
+#endif
+
 
 !------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!-- Prescribed net radiation
-!------------------------------------------------------------------------------!
-    SUBROUTINE radiation_constant
-
-       rad_net = net_radiation
-
-    END SUBROUTINE radiation_constant
+!-- Calculate temperature tendency due to radiative cooling/heating.
+!-- Cache-optimized version.
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_tendency_ij ( i, j, tend )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dzw
+
+       USE cloud_parameters,                                                   &
+           ONLY:  pt_d_t, cp
+
+       USE control_parameters,                                                 &
+           ONLY:  rho_surface
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: i, j, k
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tend
+
+#if defined ( __rrtmg )
+
+       REAL(wp) :: rad_sw_net_l, rad_sw_net_u, rad_lw_net_l, rad_lw_net_u
+
+       rad_sw_net_l = 0.0_wp
+       rad_sw_net_u = 0.0_wp
+       rad_lw_net_l = 0.0_wp
+       rad_lw_net_u = 0.0_wp
+
+!
+!--    Calculate radiative flux divergence
+       DO k = nzb+1, nzt+1
+
+          rad_sw_net_l = rad_sw_in(k-1,j,i) - rad_sw_out(k-1,j,i)
+          rad_sw_net_u = rad_sw_in(k,j,i)   - rad_sw_out(k,j,i)
+          rad_lw_net_l = rad_lw_in(k-1,j,i) - rad_lw_out(k-1,j,i)
+          rad_lw_net_u = rad_lw_in(k,j,i)   - rad_lw_out(k,j,i)
+
+          tend(k,j,i) = tend(k,j,i) + ( rad_sw_net_u - rad_sw_net_l            &
+                                      + rad_lw_net_u - rad_lw_net_l ) /        &
+                                     ( dzw(k) * cp * rho_surface ) * pt_d_t(k) 
+       ENDDO
+
+#endif
+
+    END SUBROUTINE radiation_tendency_ij
+
 
 !------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!-- Implementation of the RRTM radiation_scheme
-!------------------------------------------------------------------------------!
-    SUBROUTINE radiation_rrtm
-
-
-    END SUBROUTINE radiation_rrtm
+!-- Calculate temperature tendency due to radiative cooling/heating.
+!-- Vector-optimized version
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_tendency ( tend )
+
+       USE arrays_3d,                                                          &
+           ONLY:  dzw
+
+       USE cloud_parameters,                                                   &
+           ONLY:  pt_d_t, cp
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys
+
+       USE control_parameters,                                                 &
+           ONLY:  rho_surface
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: i, j, k
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tend
+
+#if defined ( __rrtmg )
+
+       REAL(wp) :: rad_sw_net_l, rad_sw_net_u, rad_lw_net_l, rad_lw_net_u
+
+       rad_sw_net_l = 0.0_wp
+       rad_sw_net_u = 0.0_wp
+       rad_lw_net_l = 0.0_wp
+       rad_lw_net_u = 0.0_wp
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+!
+!--          Calculate radiative flux divergence
+             DO k = nzb+1, nzt+1
+
+                rad_sw_net_l = rad_sw_in(k-1,j,i) - rad_sw_out(k-1,j,i)
+                rad_sw_net_u = rad_sw_in(k  ,j,i) - rad_sw_out(k  ,j,i)
+                rad_lw_net_l = rad_lw_in(k-1,j,i) - rad_lw_out(k-1,j,i)
+                rad_lw_net_u = rad_lw_in(k  ,j,i) - rad_lw_out(k  ,j,i)
+
+                tend(k,j,i) = tend(k,j,i) + ( rad_sw_net_u - rad_sw_net_l      &
+                                      + rad_lw_net_u - rad_lw_net_l ) /        &
+                                      ( dzw(k) * cp * rho_surface ) * pt_d_t(k) 
+             ENDDO
+         ENDDO
+       ENDDO
+#endif
+
+    END SUBROUTINE radiation_tendency
 
  END MODULE radiation_model_mod
Index: /palm/trunk/SOURCE/read_3d_binary.f90
===================================================================
--- /palm/trunk/SOURCE/read_3d_binary.f90	(revision 1584)
+++ /palm/trunk/SOURCE/read_3d_binary.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Adapted for RRTMG
 ! 
 ! Former revisions:
@@ -111,5 +111,6 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY: rad_net_av, rad_sw_in_av
+        ONLY: rad_net, rad_net_av, rad_lw_in, rad_lw_in_av, rad_lw_out,        &
+              rad_lw_out_av, rad_sw_in, rad_sw_in_av, rad_sw_out, rad_sw_out_av
 
     USE random_function_mod,                                                   &
@@ -333,5 +334,5 @@
 !--    First compare the version numbers
        READ ( 13 )  version_on_file
-       binary_version = '4.0'
+       binary_version = '4.1'
        IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
           WRITE( message_string, * ) 'version mismatch concerning data ',      &
@@ -812,4 +813,12 @@
                              tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
 
+                CASE ( 'rad_net' )
+                   IF ( .NOT. ALLOCATED( rad_net ) )  THEN
+                      ALLOCATE( rad_net(nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_2d
+                   rad_net(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  = &
+                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
                 CASE ( 'rad_net_av' )
                    IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
@@ -819,12 +828,67 @@
                    rad_net_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  = &
                                           tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+                CASE ( 'rad_lw_in' )
+                   IF ( .NOT. ALLOCATED( rad_lw_in ) )  THEN
+                      ALLOCATE( rad_lw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_lw_in(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'rad_lw_in_av' )
+                   IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
+                      ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_lw_in_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'rad_lw_out' )
+                   IF ( .NOT. ALLOCATED( rad_lw_out ) )  THEN
+                      ALLOCATE( rad_lw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_lw_out(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'rad_lw_out_av' )
+                   IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
+                      ALLOCATE( rad_lw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_lw_out_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'rad_sw_in' )
+                   IF ( .NOT. ALLOCATED( rad_sw_in ) )  THEN
+                      ALLOCATE( rad_sw_in(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_sw_in(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
 
                 CASE ( 'rad_sw_in_av' )
                    IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-                      ALLOCATE( rad_sw_in_av(nysg:nyng,nxlg:nxrg) )
-                   ENDIF  
-                   IF ( k == 1 )  READ ( 13 )  tmp_2d
-                   rad_sw_in_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  = &
-                                          tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+                      ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_sw_in_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'rad_sw_out' )
+                   IF ( .NOT. ALLOCATED( rad_sw_out ) )  THEN
+                      ALLOCATE( rad_sw_out(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_sw_out(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'rad_sw_out_av' )
+                   IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
+                      ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                   ENDIF  
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   rad_sw_out_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &
+                             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
 
                 CASE ( 'random_iv' )  ! still unresolved issue
Index: /palm/trunk/SOURCE/read_var_list.f90
===================================================================
--- /palm/trunk/SOURCE/read_var_list.f90	(revision 1584)
+++ /palm/trunk/SOURCE/read_var_list.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Adapted for RRTMG
 ! 
 ! Former revisions:
@@ -162,4 +162,7 @@
 
     USE pegrid
+
+    USE radiation_model_mod,                                                   &
+        ONLY: time_radiation
 
     USE statistics,                                                            &
@@ -609,4 +612,6 @@
           CASE ( 'time_dvrp' )
              READ ( 13 )  time_dvrp
+          CASE ( 'time_radiation' )
+             READ ( 13 )  time_radiation
           CASE ( 'time_restart' )
              READ ( 13 )  time_restart
Index: /palm/trunk/SOURCE/sum_up_3d_data.f90
===================================================================
--- /palm/trunk/SOURCE/sum_up_3d_data.f90	(revision 1584)
+++ /palm/trunk/SOURCE/sum_up_3d_data.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Adapted for RRTMG
 ! 
 ! Former revisions:
@@ -112,5 +112,7 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av
+        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av, rad_sw_out,       &
+               rad_sw_out_av, rad_lw_in, rad_lw_in_av, rad_lw_out,             &
+               rad_lw_out_av
 
     IMPLICIT NONE
@@ -326,9 +328,27 @@
                 rad_net_av = 0.0_wp
 
-             CASE ( 'rad_sw_in*' )
+             CASE ( 'rad_lw_in' )
+                IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
+                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                ENDIF
+                rad_lw_in_av = 0.0_wp
+
+             CASE ( 'rad_lw_out' )
+                IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
+                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                ENDIF
+                rad_lw_out_av = 0.0_wp
+
+             CASE ( 'rad_sw_in' )
                 IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
-                   ALLOCATE( rad_sw_in_av(nysg:nyng,nxlg:nxrg) )
+                   ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
                 ENDIF
                 rad_sw_in_av = 0.0_wp
+
+             CASE ( 'rad_sw_out' )
+                IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
+                   ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                ENDIF
+                rad_sw_out_av = 0.0_wp
 
              CASE ( 'rho' )
@@ -732,8 +752,38 @@
              ENDDO
 
-          CASE ( 'rad_sw_in*' )
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   rad_sw_in_av(j,i) = rad_sw_in_av(j,i) + rad_sw_in(j,i)
+          CASE ( 'rad_lw_in' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) + rad_lw_in(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'rad_lw_out' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) + rad_lw_out(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+
+          CASE ( 'rad_sw_in' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) + rad_sw_in(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+
+          CASE ( 'rad_sw_out' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO  k = nzb, nzt+1
+                      rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) + rad_sw_out(k,j,i)
+                   ENDDO
                 ENDDO
              ENDDO
Index: /palm/trunk/SOURCE/time_integration.f90
===================================================================
--- /palm/trunk/SOURCE/time_integration.f90	(revision 1584)
+++ /palm/trunk/SOURCE/time_integration.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Moved call of radiation scheme. Added support for RRTM
 ! 
 ! Former revisions:
@@ -226,6 +226,6 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY: dt_radiation, irad_scheme, radiation, radiation_clearsky,        &
-              radiation_constant, radiation_rrtm, time_radiation
+        ONLY: dt_radiation, radiation, radiation_clearsky,                     &
+              radiation_rrtmg, radiation_scheme, time_radiation
 
     USE statistics,                                                            &
@@ -362,4 +362,23 @@
           ENDIF
 
+          IF ( radiation .AND. intermediate_timestep_count                     &
+               == intermediate_timestep_count_max  )  THEN
+
+               time_radiation = time_radiation + dt_3d
+
+             IF ( time_radiation >= dt_radiation )  THEN
+
+                CALL cpu_log( log_point(50), 'radiation', 'start' )
+
+                time_radiation = time_radiation - dt_radiation
+                IF ( radiation_scheme == 'clear-sky' )  THEN
+                   CALL radiation_clearsky
+                ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
+                   CALL radiation_rrtmg
+                ENDIF
+
+                CALL cpu_log( log_point(50), 'radiation', 'stop' )
+             ENDIF
+          ENDIF
 !
 !--       Solve the prognostic equations. A fast cache optimized version with
@@ -597,22 +616,4 @@
 !--       2) run soil model 
           IF ( land_surface )  THEN
-
-             time_radiation = time_radiation + dt_3d
-
-             IF ( time_radiation >= dt_radiation )  THEN
-
-                CALL cpu_log( log_point(50), 'radiation', 'start' )
-
-                time_radiation = time_radiation - dt_radiation
-                IF ( irad_scheme == 0 )  THEN
-                   CALL radiation_constant              
-                ELSEIF ( irad_scheme == 1 )  THEN
-                   CALL radiation_clearsky
-                ELSEIF ( irad_scheme == 2 )  THEN
-                   CALL radiation_rrtm
-                ENDIF
-
-                CALL cpu_log( log_point(50), 'radiation', 'stop' )
-             ENDIF
 
              CALL cpu_log( log_point(54), 'land_surface', 'start' )
@@ -693,4 +694,5 @@
              !$acc update device( vpt ) 
           ENDIF 
+
 !
 !--       Compute the diffusion quantities
Index: /palm/trunk/SOURCE/user_init_land_surface.f90
===================================================================
--- /palm/trunk/SOURCE/user_init_land_surface.f90	(revision 1584)
+++ /palm/trunk/SOURCE/user_init_land_surface.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Changed description text
 ! 
 ! Former revisions:
@@ -52,5 +52,5 @@
 
 !
-!-- Here the user-defined grid initializing actions follow:
+!-- Here the user-defined land surface initialization actions follow:
 
 
Index: /palm/trunk/SOURCE/user_init_radiation.f90
===================================================================
--- /palm/trunk/SOURCE/user_init_radiation.f90	(revision 1585)
+++ /palm/trunk/SOURCE/user_init_radiation.f90	(revision 1585)
@@ -0,0 +1,56 @@
+ SUBROUTINE user_init_radiation
+
+!--------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the terms
+! of the GNU General Public License as published by the Free Software Foundation,
+! either version 3 of the License, or (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2014 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! Initial revision
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! 
+! Description:
+! ------------
+! Execution of user-defined actions to initiate the radiation model
+!------------------------------------------------------------------------------!
+
+    USE arrays_3d
+    
+    USE control_parameters
+    
+    USE indices
+    
+    USE kinds
+
+    USE radiation_model_mod
+    
+    USE user
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) :: i   !: running index
+    INTEGER(iwp) :: j   !: running index
+
+!
+!-- Here the user-defined radiation initialization actions follow:
+
+
+
+ END SUBROUTINE user_init_radiation
+
Index: /palm/trunk/SOURCE/write_3d_binary.f90
===================================================================
--- /palm/trunk/SOURCE/write_3d_binary.f90	(revision 1584)
+++ /palm/trunk/SOURCE/write_3d_binary.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Adapted for RRTMG
 ! 
 ! Former revisions:
@@ -102,5 +102,7 @@
     
     USE radiation_model_mod,                                                   &
-        ONLY: radiation, rad_net_av, rad_sw_in_av
+        ONLY: radiation, rad_net, rad_net_av, rad_lw_in, rad_lw_in_av,         &
+              rad_lw_out, rad_lw_out_av, rad_sw_in, rad_sw_in_av, rad_sw_out,  &
+              rad_sw_out_av
 
     USE random_function_mod,                                                   &
@@ -124,5 +126,5 @@
 !
 !-- Write arrays.
-    binary_version = '4.0'
+    binary_version = '4.1'
 
     WRITE ( 14 )  binary_version
@@ -262,10 +264,34 @@
        ENDIF 
     ENDIF
+    IF ( ALLOCATED( rad_net ) )  THEN
+       WRITE ( 14 )  'rad_net             ';  WRITE ( 14 )  rad_net  
+    ENDIF
     IF ( radiation )  THEN
        IF ( ALLOCATED( rad_net_av ) )  THEN
           WRITE ( 14 )  'rad_net_av          ';  WRITE ( 14 )  rad_net_av  
        ENDIF  
+       IF ( ALLOCATED( rad_lw_in ) )  THEN
+          WRITE ( 14 )  'rad_lw_in           ';  WRITE ( 14 )  rad_lw_in  
+       ENDIF
+       IF ( ALLOCATED( rad_lw_in_av ) )  THEN
+          WRITE ( 14 )  'rad_lw_in_av        ';  WRITE ( 14 )  rad_lw_in_av  
+       ENDIF 
+       IF ( ALLOCATED( rad_lw_out ) )  THEN
+          WRITE ( 14 )  'rad_lw_out          ';  WRITE ( 14 )  rad_lw_out 
+       ENDIF 
+       IF ( ALLOCATED( rad_lw_out_av ) )  THEN
+          WRITE ( 14 )  'rad_lw_out_av       ';  WRITE ( 14 )  rad_lw_out_av  
+       ENDIF 
+       IF ( ALLOCATED( rad_sw_in ) )  THEN
+          WRITE ( 14 )  'rad_sw_in           ';  WRITE ( 14 )  rad_sw_in  
+       ENDIF 
        IF ( ALLOCATED( rad_sw_in_av ) )  THEN
-          WRITE ( 14 )  'rad_sw_in_av          ';  WRITE ( 14 )  rad_sw_in_av  
+          WRITE ( 14 )  'rad_sw_in_av        ';  WRITE ( 14 )  rad_sw_in_av  
+       ENDIF 
+       IF ( ALLOCATED( rad_sw_out ) )  THEN
+          WRITE ( 14 )  'rad_sw_out          ';  WRITE ( 14 )  rad_sw_out  
+       ENDIF 
+       IF ( ALLOCATED( rad_sw_out_av ) )  THEN
+          WRITE ( 14 )  'rad_sw_out_av       ';  WRITE ( 14 )  rad_sw_out_av  
        ENDIF 
     ENDIF
Index: /palm/trunk/SOURCE/write_var_list.f90
===================================================================
--- /palm/trunk/SOURCE/write_var_list.f90	(revision 1584)
+++ /palm/trunk/SOURCE/write_var_list.f90	(revision 1585)
@@ -20,5 +20,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Adapted for RRTMG
 ! 
 ! Former revisions:
@@ -147,4 +147,7 @@
     
     USE pegrid
+
+    USE radiation_model_mod,                                                   &
+        ONLY: time_radiation
 
     USE statistics,                                                            &
@@ -522,4 +525,6 @@
     WRITE ( 14 )  'time_dvrp                     '
     WRITE ( 14 )  time_dvrp
+    WRITE ( 14 )  'time_radiation                '
+    WRITE ( 14 )  time_radiation
     WRITE ( 14 )  'time_restart                  '
     WRITE ( 14 )  time_restart
